Session Store_Buffer_Reduction

Theory ReduceStoreBuffer

(* Copyright (C) 2007--2010 Norbert Schirmer
 * All rights reserved, DFKI GmbH 
 *)
theory ReduceStoreBuffer
imports Main
begin
(*
Basic access policy:
shared + owned by some thread (only the owner is allowed to write): 
 - owner: LMS, volatile writes and arbitrary reads; 
 - others: volatile reads

shared + not owned by any thread:
 - read/write: LMS, volatile writes and volatile reads
 - read-only: arbitrary reads

The core argument in the simulation proof is to show that all reads can be executed in the
virtual machine, preserving the values they have seen in the store-buffer machine.

 * Non volatile reads *

non-volatile means that the tread knows everything about the evolution of the value. It is thread local
or read only. Writes in other store buffers may not interfere with non-volatile reads.
Complicated case:
i: [Load (read-only) a (m a)]
j: [Acq {a}, Write a v]

This may only be sceduled such that i comes first and then j. If Acq {a} already happend, safety of
the Load would be violated.
So when i is poised to Load, and j has already executed on the virtual machine we have a safety
violation.
On the other hand, if i has already executed on the virtual machine ("m a" has ben seen) and the
Acq of j is fine.

Not that read-only loads (before the first volatile store) in the store buffer may become stale before 
they hit memory.
 
 * volatile reads *

The value seen can depend on writes of other threads. That is why the flushing policy enforces the
store-buffer to be empty, if there is an outstanding volatile write in the store-buffer.
The volatile reads must be executed in the virtual machine at the time
they are issued to the store-buffer, to ensure that both machines see the same value.
It is perfectly valid that volatile reads in the store buffer become stale, e.g.
i: [VLoad a (m a)]
j: [VWrite a v]

As j's write is committed to memory the (history-)entry in i's store-buffer becomes stale. But as the
virtual machine has also already executed the load this is fine.

Complicated case:
i: [VLoad a (m a)]
j: [Write a v, Release {a}]

As i sees (m a) and not v it has to come first. 
But if j has already executed and released a, there is no
safety-violation when i is poised to execute the VLoad afterwards. This would lead to the wrong value (v instead of "m a", but we cannot rule out the scheduling by a safety argument.

Currently we avoid this situation, by coupling Releases to volatile Writes. Hence the Release is
not yet executed in the virtual machine and thus VLoad of i is unsafe.

Another solution would be to go back in time, to the state before Release {a} is executed, and argue
that this scheduling is also valid and would lead to a safeness violation and thus must be disregarded.


Some thoughts.:

I think some key to free-flowing release story is the following:

    flushed      suspended
   /       \ /               \
i: […, …  , Write True,…,…]
j: […, …  , Write True,…,…]
   \       / \               /
     races     races ruled 
      ok         out by 
                 safety

Races in the flushed part are ok, since they are already simulated in the virtual machine.
The problem is how to formulate the invariants and all the stuff that this works out in the
proof. E.g. 

i: [Write a v, Release {a}]
j: poised: Rread a

So the idea doesn't seem to work. It may only work as long as no write is involved. (i.e. Release / Acq)

FIXME: 
shared: does not seem to buy anything right now, as owner has to do volatile reads and writes.
(It should be possible that the owner does non-volatile reads, but as he is the only writer reading makes no
sense)
LMS: maybe store restriction could be relayed to owned + shared, if there is no sharing anymore there are no restrictions.

What could be better is read-only memory which can be read accessed non-volatily.

a: either owned by some thread;
   either unowned by any thread and read/write;
   either unowned by any thread and read-only:a

but how does memory become read-only?

Free-Flowing releases:
Take proof as is, and augment machnes with set of released since last flush state.
xsafety: nobody is allowed to acquire / write to released things:

Second: proof that safety ==> xsafety for virtual machine (by induction on ->*, and an initial configuration).
*)

(*
FIXME, think about this:
Introduce additional control state for the direct-machine to keep track of whether
there is an outstanding volatile store, and the set of acquired variables since the
last flush. Add this protocol to the 'good'-stuff. This should make the 
enough-flushs invariant unnecessary, and it would make it more straightforward to introduce
state-dependencies to A,L,R (maybe from the temporaries and ghost state?). If state dependencies make sense depends on the integration into PIMP.   


A stricter separation of ghost and ordinary state would be nice.
shared: global ghost state
owned: local ghost state.

SB-Machine independent of ghost state.
D-Machine uses all of it.
SBH-Machine uses it only as history information 


## notes: ernie 3. July 2009
#################################################################


final theorem:
 safe-free-flowing ⟹ sb-machine is sequential consistent

we basically have (modulo dummy delay) :
 safe-delayed ⟹ sb-machine is sequential consistent


need theorem
safe-free-flowing ⟹ safe-dalayed

prf by contraposition and induction on execution:

S unsafe-dalayed ⟹ S unsafe free-flowing
induction on S:
let t be last step of T (owning the disuputed address)

by Lemma: ∃S'. |S'| < |S| and
   S' ∘ t ∼ S and S' reachable

   case: t = release (L) then S' is unsafe free flowing ⟹ S unsafe free flowing
   otherwise: S' unsafe delayed by induction S' unsafe free flowing ⟹ S unsafe free flowing



Lemma:

S is reachable and 
last step of thread T is t, which is not a volatile write
then

∃S' reachable. |S'| < |S| ∧ S' ∘ t ∼ S   (∼: states are equal modulo stuff owned by T)
proof

 * S = <>, tivial.
 * S = S1 ∘ t, trivial.
 * S = S1 ∘ u,  (u ≠ t)
    (induction): ∃S1' ∼ S1 ∘ t
      moreover: t ∘ u ∼ u ∘ t
    
      ultimately: S = S1 ∘ u ∼ S1' ∘ t ∘ u ∼ S1' ∘ u ∘ t ∼ S1 ∘ t
   
6.10.2009: 
I don't think this proof works. The problem are volatile reads. We cannot just reschedule them
to the end, since the memory content may well be changed by intermediate volatile writes of other
threads.

It might be possible to come up with another lemma that says that we can delete the
last action thread T (if its not a volatile write), since this operation should not
have an effect on the following ops of the other threads.   
*)

(* ****************** 2.10.2009 *************************** *)
(*
Some new thoughts to introduce free-flowing releases in current proof scheme:

* introduce safety notion on store-buffer machine as well: safe_sb
* safe_sb takes also store-buffer content into accout, e.g. 
  I'm not allowed to acquire what is acquired in someone elses sb.
* make safe_sb a part of invariant on sb machine.
* to show that safe_sb is preserved builds on safe_reach of virtual machine

* safe_sb makes it possible to deal with releases in prefixes:
     
aforementioned complicated case is not safe_sb, as a is still owned (and not shared) by j
i: [VLoad a (m a)]
j: [Write a v, Release {a}]

what about:
i: [VLoad a (m a)]
j: [VWrite a v, Release {a}] (a is owned by j but is also shared)

j's sb is suspended. Hence v has not yet made it to memory. Hence i sees (m a) as expected.

Examples: preservation of safe_sb
config 1
i: Acq a 
j: Acq a   

  is safe_sb (if nowbody owns a)

config 2:
i: Acq a
j: [Acq a]

  should not be safe_sb.
  
  rule out by safe_reach on config 1.
  fast-forward either sb of i or j and execute the Acq a. Then the remaining Acq a is unsafe.

Important for safe_sb is, that for the current thread, the ghost-state (on ownership) is after executing its sb!
Otherwise one has problems with quite simple things, e.g. a step 
(1) i: Acq a; Write a;    owns = {}
(2) i: Write a; [Acq a]   owns = {}

assume (1) is safe_sb; Why should (2) be safe_sb?
It is if we consider acquire [Acq a] owns = {a} instead. And we know that it has to be acquired somewhere
in the store-buffer by exploiting safe_reach.

Maybe its better not to use safe_sb on the sb-state but on the state of the virtual machine.
Better in the sense that it is easier to connect it with safe_reach.


### 5.10 ###
Can't get safe_sb inductive.

consider:
i: [Rel a]
j: someting; Acq a; []
this is still safe_sb; but after one step where something is executed I have
i: [Rel a]
j: Acq a; []
this should not be safe_sb; but I have no arguments at hand.

### next idea ###
The control flow (and the reads) of a thread do not depend on the 'flush' parts of *other* threads, but can depend
on their own flush parts.

Moreover the information of the store buffer machine is not enough to construct a virtual execution that will
violate safety. We have to go back in time even further. An virtual machine that just suspends everything is not
inductive according to the rules of virtual machine steps: e.g.
State 1)
m
i: [VRead a (m a)]
j: [VWrite a 5]

State 2)
m(a:=5)
i: [VRead a (m a)]
j: []

State 1 could still be executed on a virtual machine that has i and j suspended, but State 2 not 
(since a is already visible).

What could help is we just take an extra starting config for the virtual machine for which we have:

csb ∼ cv
csb ∼i ci; (we get virtual config ci by flushing (only) store buffer i until first volatile write, 
            all other buffers are suspended)

c →* cv
∀i. c →* ci
safe_reach c;

we show: csb → csb' ⟹ cv →* cv'

(hence we immediately have inductivity of c with respect to steps from cv : c →* cv →* cv')
What about ci → ci'

  * for thread ci it should work similar as for cv'
  * if thread i takes a step then we also have to justify cj → cj'. 
    when something enters the storebuffer i it is just stuttering (as i is just suspended)
    when something of thread i leaves the store-buffer it is also in the front of
    the instructions in i (since suspended) and may only depend on volatile writes
    in thread j, but those are also suspended.


The next question is can we instantiate the theorem with some kind of initial state?
For a state where the store-buffers are all empty we should have:
csb == cv == c == ci 

Hence we trivially have all reachability constraints, and safe_reach c == safe_reach cv

Problem with this approach: just suspending all other threads does not work.
consider justification of thread i for step ci → ci', where thread j takes a step, namely a volatile read.
volatile read can become stale in the store buffer (e.g. by a volatile write in thread i). Hence
we cannot simulate this read. (Thats why we flush all store-buffers until first volatile write in cv).
i: [VWrite a 5]
j: [VRead a 0]

i's virtual view:
i: VWrite a 5
j: VRead a 0

if i takes a step with Write a 5, we have a problem simulating j's stale read.

j's virtual view:
i: VWrite a 5
j: (Read has already happened)




Other problem:
i: [VWrite b 5] Acq a
j: [Rel a; VRead b 0]

Thread j has to execute before i to justify the read. But intuitively in ci, we wanted to delay the 'Rel a' such that
we can say 'Acq a' in thread i is unsafe.

#### 08.10.2009 ##################################
### Refined Approach for Free Flowing Releases ###
##################################################

  General setup
  -------------

Two safety predicates: 
 * safe_free_flowing: free flowing ghost releases in instruction stream
 * safe_delayed: release is delayed until next volatile write

safe_delayed is a variant of our current model, where 'Ghost' can only acquire, 
and releases are coupled with volatile (or interlocked) writes. However we don't 
want to introduce 2 different instruction streams (one with releases
and one without but with a proper annotation at the next volatile write). 
Instead we attempt to model safe-delayed with additional ghost state. 
Mainly a thread local set 'rel' of releases addresses (since the last volatile write). 
A volatile write resets this set, and a ghost release adds to this set, 
and safe_delayed may check these sets, whereas safe_free_flowing ignores these sets. 
Example: thread i poised for "Acquire A"

safe_free_flowing: 

  ∀j ≠ i. A ∩ ownsj = {}  ("A not owned by others")

safe_delayed:

  ∀j ≠ i. A ∩ (ownsj ∪ relj)= {}  ("A not owned by others, 
                                   or release not yet committed")

(sanity check: safe_delayed is more restrictive than safe_free_flowing, i.e. 
  safe_delayed c ⟹ safe_free_flowing c)

safe_reach safe c ≡ ∀c'. c ⇒* c' ⟹ safe c'
safe_reachn safe c ≡ ∀c'. c ⇒n c' ⟹ safe c'

Then we show two main theorems:

Theorem 1 (Simulation):
[|csbsb csb'; csb ∼ c; safe_reach safe_delayed c|]
⟹
∃c'. csb' ∼ c' ∧ csb* c'

Proof.
  Hopefully straightforward adoption of current proof.
Qed. 
Theorem 1 can easily be extended to many steps csbsb* csb'

Definition: init c ("initial state")
  Intuition: state where safe_delayed and safe_free_flowing are in-sync
  That is: all reli = {};

Fact:
init c ⟹ safe_free_flowing c ⟶ safe_delayed c;


Theorem 2 (Safety):
[|safe_reach safe_free_flowing c; init c|]
⟹
safe_reach safe_delayed c
Proof.

One basic ingredient is contraposition: 
from an unsafe_delayed computation we attempt to construct an unsafe_free_flowing computation.

Scenario for intuition:

  thread i:  …    Rel {a} …    |   … VWrite 
  thread j:  …       |    … Acq {a} 

thread i is somewhere in the computation between its release and the next volatile write.
thread j tries to Acq {a} inbetween.

This is safe_free_flowing (as the release has already happened), but not safe_delayed.
We want to argue that there is another scheduling of the global computation 
such that we also get a violation of safe_free_flowing.

For thread i we know that there are no volatile writes after the release until 
we hit the violation of safe_delayed. Intuitively this means that the other 
threads 'do not depend' on what is computed inside thread i after the release.
Note that the opposite is not the case. There can be volatile reads in thread i, 
which depend on (volatile) writes of 
other threads.

e.g.

  thread i:  …    Rel {a} …            … VRead b 5 …    |  … VWrite 
  thread j:  …       |    … VWrite b 6 …          …  Acq {a} 

This means that Read b 5 must come before VWrite b 6.

In general this implies that we cannot just reorder all steps of thread i 
(beginning from Rel {a}) after the Acq {a} in thread j to construct an 
unsafe_free_flowing state. 

It suggests that we instead try to *remove* all steps from thread i 
(beginning from and including Rel {a}) from the global computation, 
and argue that the other threads (especially j) can still do their 
computations until we reach a violation of safe_free_flowing 
(at latest at the Acq {a}).

There can be other violations before (but that is also fine) e.g.
  

  thread i:  …    Rel {a} …   Acq {b}; Write b 10; Rel {b}  …    |  … VWrite 
  thread j:  …       |    … VRead b 20     …              …   Acq {a}

We attempt to construct an unsafe_free_flowing state for the conflict 
with respect to a. But while we remove instructions from thread i, we 
encounter the violation with respect to b. As any violation of safe_free_flowing
is fine, this still fits into the proof.

The proof in more detail.
We do induction on the length of the computation.

[|safe_reachn safe_free_flowing c; init c|]
⟹
safe_reachn safe_delayed c

  Case n=0
  --------

From fact on "init c" we know that safe_free_flowing c ⟹ safe_delayed c;
safe_reach0 safe_free_flowing c <=> safe_free_flowing c ⟹ safe_delayed c <=> safe_reach0 safe_delayed c

  Case n → n+1
  -------------

Consider a trace: c(i) where c(0) = c; c(i) ⇒ c(i+1) for i <= n;
if there would be an k ≤ n for which ¬ safe_delayed c(k) we have ¬ safe_reachn safe_delayed c and by induction hypothesis
also ¬ safe_reachn safe_free_flowing c.

So we have:

∀k ≤ n. safe_delayed c(k)

¬ safe_delayed c(n+1)

Moreover we assume

∀k ≤ n + 1. safe_free_flowing c(k)

(if we have  ¬ safe_free_flowing c(k) we have ¬ safe_reachn safe_free_flowing c and are finished)

We do case distinction on '¬ safe_delayed c(n+1)'.
Some cases are trivially ruled out because of 'safe_free_flowing c(n+1)'.

Let us consider the case of 'safety violation due to an Acq A'

We get two racing threads i,j. Let j be the one issuing the 'Acq A'.

From ¬ safe_delayed c(n+1):

  A ∩ (ownsi ∪ reli) ≠ {}

From safe_free_flowing c(n+1):

 A ∩ (ownsi) = {}

hence there is an a ∈ A and a ∈ reli.

Let k < n+1 be the index where thread i did its last step in the transition from : c(k) ⇒ c(k+1).
So for c(k+1) … c(n+1) the thread configuration of i does not change.


                            last step of thread i
                                    |
c(0) ⇒ …            ⇒ c(k-1) ⇒ c(k) ⇒ c(k+1) ⇒ c(k+2) ⇒ … ⇒ c(n+1) 
  
c(k) ⇒ c(k+1) can't be a volatile or interlocked write of thread i. 
Otherwise reli would be {} beginning at c(k+1) and thus there would be no a ∈ reli. (in general only ops, where we cannot assert rel={} in the post state,i.e. reads, non-volatile writes and ghost ops)

We want to remove the step c(k) ⇒ c(k+1) from the computation (by undoing tread i's last step) and argue on 
replaying the rest of the computation:

c(0) ⇒ …            ⇒ c(k-1) ⇒ c'(k+1) ⇒ … ⇒ c'(n+1) 

At latest when we reach c'(n+1) we encounter a violation of safe_delayed c'(k) (from our initial race)
This requires a LEMMA!
As the length of the trace is now ≤ n (since step k is removed) we can 
use the induction hypothesis to obtain ¬ safe_reachn safe_free_flowing c 
and hence ¬ safe_reachn+1 safe_free_flowing c.

On the LEMMA:
We want to argue on the step's like c(k-1) ⇒ c'(k+1) and then 
continuing c'(k+1) ⇒ c'(k+2).
We can always do case distinction on 'safe_delayed'. If 'not safe_delayed' 
of any config we are fine with the main proof. So for the lemma we can 
assume "safe_delayed" of the initial state. 

Consider:

* (ts,S,m) ⇒ (ts',S',m')
* tsi = ts'i  (thread i does not change)
* safe_delayed (ts,S,m)
* (uts,uS,um) is obtained from ts by "undoing tread i's last step"
  - utsj = tsj (for j≠i)
  (- (uts,uS,um) ⇒ (ts,S,m) (by a step of thread i))
  - safe_delayed (uts,uS,um)
  - ∀a ∉ uownsi. um(a) = m(a)
show:
  (uts,uS,um) ⇒ (uts',uS',um')

where
* utsi = uts'i
* uts'j = ts'j  (for j≠i)
* ∀a ∈ uownsi. um'(a) = um(a) ( this may not be necessary to know (since i only care about steps of other threads )
* ∀a ∉ uownsi. um'(a) = m'(a)

We want to extend this simulation to a trace c(0)… c(k)
We either can simulate with a trace c'(0) … c'(k) and have safe_delayed c'(k) or 
we encounter an intermediate config ¬ safe_delayed c'(i)  for (i ≤ k) 
(from which simulation may no longer be possible).

LEMMA:
Assume:
* trace c(0) ⇒ … ⇒ c(k)
* ∀l,m ≤ k. ts(l)i = ts(m)i   (tread i does not change)
* undo config for thread i: uti, uS, um (initial new configuration)

Show:
∃trace c', x ≤ k. 
(c' simulate c up to step x, and all reached states are safe_delayed)
* ∀i ≤ x. safe_delayed c'(i)
* x < k ⟶ ¬ safe_delayed c'(x+1)
* ∀l ≤ x. ts'(l)i = uti       (tread i does not change)
* S'(0) = uS
* m'(0) = um

* ∀l ≤ x. ∀j≠i. ts'(l)j = ts(l)j            (tread j is simulated)
* ∀l ≤ x. ∀a ∉ uownsi. m'(l)(a) = m(l)(a) 
* ∀l ≤ x. ∀a ∉ uownsi. S'(l)(a) = S(l)(a) 
* ∀l,o ≤ x. ∀a ∈ uownsi. S'(l)(a) = S'(o)(a)  (sharing of thread i stays constant)

(In case we reach the final state k, we know enough about preservation of the 
ownership and sharing ghost state to (re)construct the initial race in our main proof).




######################################################################
### Thoughts on extensions ###########################################
######################################################################

There is a common ideom for concurrency control that we currently
cannot deal with properly within our programming discipline, typically for
acquiring like ops (like acquiring a lock) and releases:

Acquire
Barrier

Barrier
Release

The Acquire is an interlocked write (or a volatile write followed by a barrier)
but the release is an ordinary volatile write, where maybe there is a barrier in front of it
(I think the reason for this is to prohibit certain compiler optimizations) but there is no
barrier after it. That means in our model, that the release leaves the store-buffer-state dirty.
And we would have to insert a flush before the next volatile read.
This extra flush is currently not done. The intuitive reason behind this is, that it is
totally ok if other threads can only observe the release with a delay, since they don't do any
harm by waiting for the release (typically they just wait in an polling loop).
Ideally what we would like in our model is:

1. We want to allow releasing writes (like lock release or leave-turnstile) to leave the store-buffer-state clean, 
such that subsequent volatile reads do not require a flush.

2. The idea why this works is that other threads that may depend on the release but have not yet seen the releasing write do nothing bad, but are basically in a polling - loop (like lock acquire or wait-for-turnstile). So when the releasing write is not yet out of the store-buffer the store-buffer machine my take an extra polling loop (compared to an sequential consistent execution, where the write is considered immediately flushed to memory). But any final state (where all store-buffers are empty) should still be reachable by an sequential consistent execution.

For simulation 2. suggests that the waiting thread of the virtual machine should just stay in the same state as long as the 
sb-machine is captured in the polling loop. So the sb-machine takes extra turns, whereas the virtual machine does nothing. Formally, this is an issue for our model, since the sb-machine may read a lot of temporaries during the idle loop, all of which are not at all
read in the virtual machine. So expressing the simulation relation seems quite odd.
Another viewpoint is to introduce an intermediate (nondeterministic) program in the virtual machine, that always can descide and take an extra polling loop (without reading anything). This simulates the sb-program (modulo the extra reads to temporaries in the sb-program). In a second step we can argue that we can refine the intermediate program to the real program (all in the virtual machine) and still calculate the same *result*.

For wait-for-turnstile the pooling loop is even harder to justify being irrelevant compared to a spin-lock-acquire.
Wait-for-turnstile takes 2 samples and compares if they have changed. If not it waits and takes another sample, otherwise it continues.
So we really have to be able to compare the 2 values and deduce something from it. So they can't be just regarded as arbitrary values.

Spinlock-example:

Thread i: (release l in sb)
[l := 0 (release l)]

Thread j: (trying to acquire)
while (test&set l)...

If we maintain our flushing policy, and treat the l:=0 as nonvolatile (to keep the status clean), the release is already visible
in the virtual machine and thus the test&set succeeds emmediately, whereas in the sb-machine thraed j has to spin.

Idea:
1. Releasing writes are treated akin to non-volatile writes with respect to flushing policy 
(maybe we give them an extra name at some point)
2. To justify the non-volatile status when we want to write to them they have to be owned and *unshared*
   => This currently prohibits other threads to even read from them, which is bad for a memory cell that is used
   for synchronisation.
3. To compensate for that we relax the safety restriction for volatile reads.
   => Besides the 'shared' info we introduce a 'last' info (or maybe it is somehow merged with the shared info)  
       
      last:: address => value option

   With 'last' we store the last value written at the point we acquired the address in there (e.g. the 1 when acquiring a lock)
   Note that our ownership model hopefully guarantees that this is unique. There may be only one thread
   waking on the lock as long as the release is in its store-buffer.

   acquiring-write:
   l := 1; shared = old(shared)(l := None); owns = old(owns) + {l}; last = old(last)(l:=Some 1)
   releasing-write:
   l := 0; shared = old(shared)(l := Some True); owns = old(owns) - {l}; last=old(last)

   Volatile read's are now always allowed according to safety (maybe we introduce a flag to distinguish
   those liberated volatile reads from the things we allowed before (owned or shared)).

   


   The semantics of a volatile read is also changed to nondeterministically choose between either reading
   from memory or the last-info. Note that the semantics is *only* changed in the virtual machine. The sb machine
   stays the same.

   -------------------------
   read a t → tmps(t := m a)

   last a = Some v
   -------------------------
   read a t → tmps(t := v)

   (nondeterminism ensures that a program that always reads from memory is a refinement of our program)


By reading from last we attempt to be able to simulate the sb machine taking extra loops at program points where
the virtual machine could already proceed.

Spin-Lock example:
invariant i.  m l = 0 ==> lock is free
invariant ii. last l = Some v ==> v = 1
The virtual machine may always decide to take an extra loop (in case the lock was acquired at least once), alltough m l = 0;

Note:
* Values stored in last are always values that actually where (or will be) in memory at some point.


Turnstiles:
  enter-turnstile
  x := x + 1; shared = old(shared)(x:= None); owns = old(owns) + {x}; last = old(last)(x := Some (m x + 1));
  leave-turnstile
  x := x + 1; shared = old(shared)(x:= Some True); owns = old(owns) - {x}; last = old(last);

  wait-for turnstile
  takes a sample of x and when it is odd waits until x changes (by taking at least one other sample of x)

invariant i. even (m x) ==> not in turnstile
invariant ii. last x = Some v ==> odd(v)
Note that for turnstiles we know that only one thread will increment the counter;
(What do we need to know as invariants about the relation of last x and m x?)

To see if a turnstile is cautious enough we have various cases:
1. both samples are from memory: should be safe (if turnstiles make sense at all)
2. first sample from last, second sample from memory:
   * first sample from last: we think thread is in turnstile as it is always odd
   * second sample from memory: if its the same as the first sample we continue waiting (safe)
                                if not last was either outdated and we werent in the turnstile at all, 
                                or we have really left ts at least once (safe)
3. first sample from memory, second sample from last:
   * as there is only one writer to the ts, the sample from last is always at least the counter we have seen by the first sample (safe)
4. both samples from last
   * both sample are the same, we continue waiting (safe)
   * samples are different: As only one thread writes the ts, the 'last' samples also follow the program order, hence the
     thread has left the ts at least once (safe).



Think-tank

One might try to update 'last' not only on acquire, but simply every time a write actually hits memory.
Thinking of this 'last' actually just is the memory of the store-buffer machine. To correctly update 'last' in the
virtual machine is then difficult. Currently we maintain two values: the last one (being made interlocked or with a barrier)
and the (most actual) one in the virtual machine.
What about making last a set? Storing everything what happens between the acquire and the release (or flush)?
It seems to be a history.
So the general thing seems to be:
history: address ⇒ value list;
keeping track of all values (and their order) between two flushes (or interlocked things).
A volatile read has to be able to deal with any value in the histroy, starting from the one the
thread has read last.

If we would introduce a history for each thread, we would kind of explicitely model store-buffers.
This would be the 'ultimate solution' for TSO.: 

A histroy that should work:

history:: address ⇒ (lower-bound,upper-bound,(cnt,value) set)
history a = (lb,ub,V); (n,v) ∈ V ⟹ lb ≤ ub ∧ lb ≤ n ∧ n ≤ ub; 

* every write increases the upper-bound and adds the value;
* every read increases the lower-bound (and removes all lower values)
* every flush empties the set;

write a v: 
  h a = (lb,ub,V) ⟹ h'=h(a:=(lb,ub+1,V ∪ {(ub+1,v)}))

read a v: 
  h a = (lb,ub,V); (n,v) ∈ V; lb ≤ n ∧ n ≤ ub  ⟹ h'=h(a:=(lb+1,ub,V ))

flush a
 h'=h(a:=(0,0,{}))

            read a v    
(syntax: h ----------> h')
   

The single global histroy should be fine for our case, since there is only one writer, and the reads are ordered (as they are volatile) and are in sync between the sb and the virtual machine.

26.11.2009
More thoughts on history:
Currently we see 4 operations on the history:

Read (for stale reads), Write (non-volatile) , Commit (fence), WriteCommit (volatile write and LMS)

1. A read of a thread that has an outstanding write to the same address in the store buffer, always gets this value and
  should not have influence on the lb of the history for other threads.

2. In the concurrency control we thought of up to now (spinlocks release, turnstiles, versioning writer) 
   the only use of the lb for reads is to guarantee an order in which a thread sees updates when it really
   issues multiple reads. We currently do not need arguments across threads like (if thread i has already seen a
   certain value than thread j has to see a newer one).

1 and 2 suggest that it might be a good idea to make the lb's thread local. This gives us some nice properties:
* a read only effects the thread local lb (and neiter the lb of another thread nor the history)
* a write, commit, writecommit only effects the history and no lb.
* write, commite,writecommit are completely deterministic

* To easily model fences we take the thread id into the history.

history:: address => (hb,i,V :: timestamp ⇒ value option)
lb (per thread): address ⇒ lb


selectors: 
* top (hb,i,V) = hb
* thread (hb,i,V) = i
* vals (hb,i,V) = V 

invariants:
* ∀a hb x V. h a = (hb,x,V) ⟶ ∀t ∈ dom V. t ≤ hb

* ∀a hb x V. h a = (hb,x,V) ⟶ hb ∈ dom V 

* for all threads: ∀a. lb a ≤ top (h a)

* the memory value of the sb-machine and all the values in takeWhile (Not ∘ is_volatile_Write) are in the history of the virtual machine.
  * msb a ∈ range (vals (h a))
  * Write False a v ∈ set (takeWhile (Not ∘ is_volatile_Write)) sb ⟹ v ∈ range (vals (h a))

* The top-value in the history of the virtual machine is the memory value in the virtual machine:
  vals (h a) (top (h a)) = Some (m a)

* Commit preserves top value
  
 

h'=λa. let (hb,j,V) = h a 
       in if i=j then (hb,i,V|`{hb})
          else h a
---------------------------------------
        Commit i h h'


h a = (hb,j,V)      h'=h(a:= (hb+1,i,V(hb+1 ↦ v))) 
----------------------------------------------------------
        Write i a v h h'

WriteCommit is simply first Write then Commit (in this order, to make sure that there is only one value in V)
After a WriteCommit the value read is determined.

(* not a transition just a read *)
h a = (hb,j,V)      V t = Some v    lb ≤ t
----------------------------------------------
         Read a v t lb h h
The thread updates his lb: lb(a:=t);




*)

(* 

(\([^,]*\),\([^,]*\),\([^,]*\),\([^,]*\),\([^,]*\),\([^,]*\),\([^,]*\),\([^,]*?\))

(\([^()]*\),\([^()]*\),\([^()]*\),\([^()]*\),\([^()]*\),\([^()]*\),\([^()]*\),\([^()]*\))
(\1,\2,\3,\4,\5,\6,\8)
*)

subsection ‹Memory Instructions›

type_synonym addr = nat 
type_synonym val = nat
type_synonym tmp = nat


type_synonym tmps = "tmp  val option" 
type_synonym sop = "tmp set × (tmps  val)" ― ‹domain and function›

locale valid_sop =
fixes sop :: "sop"
assumes valid_sop: "D f θ. 
          sop=(D,f); D  dom θ 
           
          f θ = f (θ|`D)"

type_synonym memory = "addr  val"
type_synonym owns = "addr set"
type_synonym rels = "addr  bool option"
type_synonym shared = "addr  bool option" 
type_synonym acq = "addr set"
type_synonym rel = "addr set"
type_synonym lcl = "addr set"
type_synonym wrt = "addr set"
type_synonym cond = "tmps  bool"
type_synonym ret = "val  val  val"

datatype instr = Read bool addr tmp 
               | Write bool addr sop acq lcl rel wrt
               | RMW addr tmp sop cond ret acq lcl rel wrt  
               | Fence 
               | Ghost acq lcl rel wrt

type_synonym instrs = "instr list"


type_synonym ('p,'sb,'dirty,'owns,'rels) thread_config = 
  "'p × instrs × tmps × 'sb × 'dirty × 'owns × 'rels"
type_synonym ('p,'sb,'dirty,'owns,'rels,'shared) global_config = 
  "('p,'sb,'dirty,'owns,'rels) thread_config list × memory × 'shared "

definition "owned t = (let (p,instrs,θ,sb,𝒟,𝒪,) = t in 𝒪)" 

lemma owned_simp [simp]: "owned (p,instrs,θ,sb,𝒟,𝒪,) = (𝒪)"
  by (simp add: owned_def)

definition "𝒪_sb t = (let (p,instrs,θ,sb,𝒟,𝒪,) = t in (𝒪,sb))" 

lemma 𝒪_sb_simp [simp]: "𝒪_sb (p,instrs,θ,sb,𝒟,𝒪,) = (𝒪,sb)"
  by (simp add: 𝒪_sb_def)

definition "released t = (let (p,instrs,θ,sb,𝒟,𝒪,) = t in )" 

lemma released_simp [simp]: "released (p,instrs,θ,sb,𝒟,𝒪,) = ()"
  by (simp add: released_def)

lemma list_update_id': "v = xs ! i  xs[i := v] = xs"
  by simp

lemmas converse_rtranclp_induct5 = 
converse_rtranclp_induct [where a="(m,sb,𝒪,,𝒮)" and b="(m',sb',𝒪',ℛ',𝒮')", split_rule,consumes 1, case_names refl step]

subsection ‹Abstract Program Semantics›

locale memory_system = 
  fixes
  memop_step ::  "(instrs × tmps × 'sb × memory × 'dirty × 'owns × 'rels × 'shared)  
                  (instrs × tmps × 'sb × memory × 'dirty × 'owns × 'rels × 'shared)  bool" 
                    ("_ m _" [60,60] 100) and
  
  storebuffer_step:: "(memory × 'sb × 'owns × 'rels × 'shared)  (memory × 'sb × 'owns × 'rels × 'shared)  bool" ("_ sb _" [60,60] 100)


locale program =
  fixes
  program_step :: "tmps  'p  'p × instrs  bool" ("_ _ p _" [60,60,60] 100) 
  ― ‹A program only accesses the shared memory indirectly, it can read the temporaries
        and can output a sequence of memory instructions›

locale computation = memory_system + program +
  constrains
  ― ‹The constrains are only used to name the types @{typ "'sb"} and  @{typ "'p"}
  storebuffer_step:: "(memory × 'sb × 'owns × 'rels × 'shared)  (memory × 'sb × 'owns × 'rels × 'shared)  bool" and
  memop_step :: "
                  (instrs × tmps × 'sb × memory × 'dirty × 'owns × 'rels × 'shared)  
                  (instrs × tmps × 'sb × memory × 'dirty × 'owns × 'rels × 'shared)  bool" 
                     and
  program_step :: "tmps  'p  'p × instrs  bool" 
  fixes
  "record" :: "'p  'p  instrs  'sb  'sb"
begin

inductive concurrent_step :: 
  "('p,'sb,'dirty,'owns,'rels,'shared) global_config  ('p,'sb,'dirty,'owns,'rels,'shared) global_config  bool"
                               ("_  _" [60,60] 100)
where
  Program: 
   "i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,);
     θp p (p',is')   
     (ts,m,𝒮)  (ts[i:=(p',is@is',θ,record p p' is' sb,𝒟,𝒪,)],m,𝒮)"

| Memop:
   "i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,);
      (is,θ,sb,m,𝒟,𝒪,,𝒮) m (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮')  
      
     (ts,m,𝒮)  (ts[i:=(p,is',θ',sb',𝒟',𝒪',ℛ')],m',𝒮')"


| StoreBuffer: 
   "i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,);
     (m,sb,𝒪,,𝒮) sb (m',sb',𝒪',ℛ',𝒮')   
     (ts,m,𝒮)  (ts[i:=(p,is,θ,sb',𝒟,𝒪',ℛ')],m',𝒮')"

definition final:: "('p,'sb,'dirty,'owns,'rels,'shared) global_config  bool"
where
 "final c = (¬ (c'. c  c'))"


lemma store_buffer_steps:
assumes sb_step: "storebuffer_step^** (m,sb,𝒪,,𝒮) (m',sb',𝒪',ℛ',𝒮')"
shows "ts. i < length ts  ts!i = (p,is,θ,sb,𝒟,𝒪,)  
         concurrent_step^** (ts,m,𝒮) (ts[i:=(p,is,θ,sb',𝒟,𝒪',ℛ')],m',𝒮')"
using sb_step 
proof (induct rule: converse_rtranclp_induct5)
  case refl then show ?case 
    by (simp add: list_update_id')
next
  case (step m sb 𝒪  𝒮 m'' sb'' 𝒪'' ℛ'' 𝒮'')
  note i_bound = i < length ts
  note ts_i = ts ! i = (p, is, θ, sb, 𝒟, 𝒪, )
  note step = (m, sb,𝒪,,𝒮) sb (m'', sb'',𝒪'',ℛ'',𝒮'')
  let ?ts' = "ts[i := (p, is, θ, sb'',𝒟, 𝒪'',ℛ'')]"
  from StoreBuffer [OF i_bound ts_i step] 
  have "(ts, m, 𝒮)  (?ts', m'', 𝒮'')".
  also
  from i_bound have i_bound': "i < length ?ts'" by simp
  from i_bound have ts'_i: "?ts'!i = (p,is,θ,sb'',𝒟,𝒪'',ℛ'')"
    by simp
  from step.hyps (3) [OF i_bound' ts'_i] i_bound
  have "concurrent_step** (?ts', m'', 𝒮'') (ts[i := (p, is, θ, sb',𝒟, 𝒪',ℛ')], m', 𝒮')"
    by (simp)
  finally
  show ?case .
qed

lemma step_preserves_length_ts: 
  assumes step: "(ts,m,𝒮)  (ts',m',𝒮')"
  shows "length ts' = length ts"
using step
apply (cases)
apply auto
done
end

lemmas concurrent_step_cases = computation.concurrent_step.cases 
[cases set, consumes 1, case_names Program Memop StoreBuffer]

definition augment_shared:: "shared  addr set  addr set  shared" ("_ ⊕⇘_ _" [61,1000,60] 61)
where
"𝒮W S  (λa. if a  S then Some (a  W) else 𝒮 a)"

definition restrict_shared:: "shared  addr set  addr set  shared" ("_ ⊖⇘_ _" [51,1000,50] 51)
where
"𝒮A L  (λa. if a  L then None 
                     else (case 𝒮 a of None  None
                            | Some writeable  Some (a  A  writeable)))"
                      
definition read_only :: "shared  addr set"
where
"read_only 𝒮  {a. (𝒮 a = Some False)}"

definition shared_le:: "shared  shared  bool" (infix "s" 50)
where 
"m1 s m2  m1 m m2  read_only m1  read_only m2"

lemma shared_leD: "m1 s m2  m1 m m2  read_only m1  read_only m2"
  by (simp add: shared_le_def)

lemma shared_le_map_le: "m1 s m2  m1 m m2"
  by (simp add: shared_le_def)

lemma shared_le_read_only_le: "m1 s m2  read_only m1  read_only m2"
  by (simp add: shared_le_def)

lemma dom_augment [simp]: "dom (mW S) = dom m  S"
  by (auto simp add: augment_shared_def)

lemma augment_empty [simp]: "Sx {} = S"
  by (simp add: augment_shared_def)


lemma inter_neg [simp]: "X  - L = X - L"
  by blast

lemma dom_restrict_shared [simp]: "dom (mA L) = dom m - L"
  by (auto simp add: restrict_shared_def split: option.splits)

lemma restrict_shared_UNIV [simp]: "(mA UNIV) = Map.empty"
  by (auto simp add: restrict_shared_def split: if_split_asm option.splits)

lemma restrict_shared_empty [simp]: "(Map.empty ⊖A L) = Map.empty"
  apply (rule ext)
  by (auto simp add: restrict_shared_def split: if_split_asm option.splits)

lemma restrict_shared_in [simp]: "a  L  (mA L) a = None"
  by (auto simp add: restrict_shared_def split: if_split_asm option.splits)

lemma restrict_shared_out: "a  L  (mA L) a = 
  map_option (λwriteable. (a  A  writeable)) (m a)"
  by (auto simp add: restrict_shared_def split: if_split_asm option.splits)

lemma restrict_shared_out'[simp]: 
  "a  L  m a = Some writeable  (mA L) a = Some (a  A  writeable)"
  by (simp add: restrict_shared_out)

lemma augment_mono_map': "A m B  (Ax C) m (Bx C)"
  by (auto simp add: augment_shared_def map_le_def domIff)

lemma augment_mono_map: "A s B  (Ax C) s (Bx C)"
  by (auto simp add:  augment_shared_def shared_le_def map_le_def read_only_def dom_def split: option.splits if_split_asm)

lemma restrict_mono_map: "A s B   (Ax C) s (Bx C)"
  by (auto simp add:  restrict_shared_def shared_le_def map_le_def read_only_def dom_def split: option.splits if_split_asm)

lemma augment_mono_aux: "dom A  dom B  dom (Ax C)  dom (Bx C)"
  by auto

lemma restrict_mono_aux: "dom A  dom B  dom (Ax C)  dom (Bx C)"
  by auto

lemma read_only_mono: "S m S'  a  read_only S  a  read_only S'"
    by (auto simp add:  map_le_def domIff read_only_def dest!: bspec)

lemma in_read_only_restrict_conv: 
  "a  read_only (𝒮A L) = (a  read_only 𝒮  a  L  a  A)"
  by (auto simp add: read_only_def restrict_shared_def split: option.splits if_split_asm)



lemma in_read_only_augment_conv: "a  read_only (𝒮W R) = (if a  R then a  W else a  read_only 𝒮)"
  by (auto simp add: read_only_def augment_shared_def)

lemmas in_read_only_convs = in_read_only_restrict_conv in_read_only_augment_conv

lemma read_only_dom: "read_only 𝒮  dom 𝒮"
  by (auto simp add: read_only_def dom_def)

lemma read_only_empty [simp]: "read_only Map.empty = {}"
  by (auto simp add: read_only_def)

lemma restrict_shared_fuse: "SA LB M = (S(A  B) (L  M))"
apply (rule ext)
apply (auto simp add: restrict_shared_def split: option.splits if_split_asm)
done

lemma restrict_shared_empty_set [simp]: "S{} {} = S"
  apply (rule ext)
  apply (auto simp add: restrict_shared_def split: option.splits if_split_asm)
  done

definition augment_rels:: "addr set  addr set  rels  rels"
where
"augment_rels S R  = (λa. if a  R
                             then (case  a of 
                                     None  Some (a  S)
                                   | Some s  Some (s  (a  S)))
                             else  a)"

declare domIff [iff del]

subsection ‹Memory Transitions›

locale gen_direct_memop_step = 
fixes emp::'rels and aug::"owns  rel  'rels  'rels"
begin
inductive gen_direct_memop_step :: "(instrs × tmps × unit × memory × bool × owns × 'rels × shared )  
                  (instrs × tmps × unit × memory × bool × owns × 'rels × shared )  bool" 
                    ("_  _" [60,60] 100)
where
  Read: "(Read volatile a t # is,θ, x, m,𝒟, 𝒪, , 𝒮) 
               (is, θ (tm a), x, m, 𝒟, 𝒪, , 𝒮)"

| WriteNonVolatile:
  "(Write False a (D,f) A L R W#is, θ, x, m, 𝒟, 𝒪, , 𝒮)  
          (is, θ, x, m(a := f θ), 𝒟, 𝒪, , 𝒮)"

| WriteVolatile:
  "(Write True a (D,f) A L R W# is, θ, x, m, 𝒟, 𝒪, , 𝒮) 
         (is, θ,  x, m(a:=f θ), True, 𝒪  A - R, emp, 𝒮W RA L)"

| Fence:
  "(Fence # is, θ, x, m, 𝒟, 𝒪, , 𝒮)  (is, θ,x, m, False, 𝒪, emp, 𝒮)"

| RMWReadOnly:
  "¬ cond (θ(tm a))  
   (RMW a t (D,f) cond ret A L R W # is, θ, x, m, 𝒟, 𝒪, , 𝒮)  (is, θ(tm a),x,m, False, 𝒪, emp, 𝒮)"

| RMWWrite:
  "cond (θ(tm a))  
   (RMW a t (D,f) cond ret A L R W# is, θ, x, m, 𝒟, 𝒪, , 𝒮)  
         (is, θ(tret (m a) (f(θ(tm a)))),x, m(a:= f(θ(tm a))), False,𝒪  A - R, emp, 𝒮W RA L)"

| Ghost:
  "(Ghost A L R W # is, θ, x, m, 𝒟, 𝒪, ,  𝒮) 
         (is, θ, x, m, 𝒟, 𝒪  A - R, aug (dom 𝒮) R  , 𝒮W RA L)"
end

interpretation direct_memop_step: gen_direct_memop_step Map.empty augment_rels .

term direct_memop_step.gen_direct_memop_step
abbreviation direct_memop_step :: "(instrs × tmps × unit × memory × bool × owns × rels × shared )  
                  (instrs × tmps × unit × memory × bool × owns × rels × shared )  bool" 
                    ("_  _" [60,60] 100)
where
"direct_memop_step  direct_memop_step.gen_direct_memop_step"

term "x  Y"

abbreviation direct_memop_steps :: "
                  (instrs × tmps × unit × memory × bool × owns × rels × shared )  
                  (instrs × tmps × unit × memory × bool × owns × rels × shared )  
                    bool" 
                    ("_ * _" [60,60] 100)
where 
"direct_memop_steps == (direct_memop_step)^**"

term "x * Y"

interpretation virtual_memop_step: gen_direct_memop_step "()" "(λS R . ())" .

abbreviation virtual_memop_step :: "(instrs × tmps × unit × memory × bool × owns × unit × shared )  
                  (instrs × tmps × unit × memory × bool × owns × unit × shared )  bool" 
                    ("_ v _" [60,60] 100)
where
"virtual_memop_step  virtual_memop_step.gen_direct_memop_step"

term "x v Y"

abbreviation virtual_memop_steps :: "
                  (instrs × tmps × unit × memory × bool × owns × unit × shared )  
                  (instrs × tmps × unit × memory × bool × owns × unit × shared )  
                    bool" 
                    ("_ v* _" [60,60] 100)
where 
"virtual_memop_steps == (virtual_memop_step)^**"

term "x * Y"



lemma virtual_memop_step_simulates_direct_memop_step: 
  assumes step:
  "(is, θ, x, m, 𝒟, 𝒪, , 𝒮)  (is', θ', x', m', 𝒟', 𝒪', ℛ', 𝒮')"
  shows "(is, θ, x, m, 𝒟, 𝒪, (), 𝒮) v (is', θ', x', m', 𝒟', 𝒪', (), 𝒮')"
using step
apply (cases)
apply (auto intro: virtual_memop_step.gen_direct_memop_step.intros)
done

subsection ‹Safe Configurations of Virtual Machines›

inductive safe_direct_memop_state :: "owns list  nat   
                  (instrs × tmps × memory × bool × owns × shared)  bool " 
                    ("_,_ _ " [60,60,60] 100)
where
  Read: "a  𝒪  a  read_only 𝒮  (volatile  a  dom 𝒮);
          volatile  ¬ 𝒟 
        
        𝒪s,i(Read volatile a t # is, θ, m, 𝒟, 𝒪, 𝒮)"

| WriteNonVolatile:
  "a  𝒪; a  dom 𝒮 
   
   𝒪s,i(Write False a (D,f) A L R W#is, θ, m, 𝒟, 𝒪, 𝒮)"

| WriteVolatile:
  "j < length 𝒪s. ij  a  𝒪s!j;     
    A  dom 𝒮  𝒪; L  A; R  𝒪; A  R = {}; 
    j < length 𝒪s. ij   A   𝒪s!j = {};
   a  read_only 𝒮
    
   𝒪s,i(Write True a (D,f) A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"

| Fence:
  "𝒪s,i(Fence # is, θ, m, 𝒟, 𝒪, 𝒮)"

| Ghost:
  "A  dom 𝒮  𝒪; L  A; R  𝒪; A  R = {}; 
    j < length 𝒪s. ij   A  𝒪s!j = {}
    
   𝒪s,i(Ghost A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"

| RMWReadOnly:
  "¬ cond (θ(tm a)); a  𝒪  a  dom 𝒮  
   𝒪s,i(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"

| RMWWrite:
  "cond (θ(tm a));  
    j < length 𝒪s. ij  a  𝒪s!j;
    A  dom 𝒮  𝒪; L  A; R  𝒪; A  R = {}; 
    j < length 𝒪s. ij  A  𝒪s!j  = {};
    a  read_only 𝒮 
    
   𝒪s,i(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"

| Nil:   "𝒪s,i([], θ, m, 𝒟, 𝒪, 𝒮)"

inductive safe_delayed_direct_memop_state :: "owns list  rels list  nat   
                  (instrs × tmps × memory × bool × owns × shared)  bool " 
                    ("_,_,_ _ " [60,60,60,60] 100)
where
  Read: "a  𝒪  a  read_only 𝒮  (volatile  a  dom 𝒮);
          j < length 𝒪s. ij  (ℛs!j) a  Some False; ― ‹no release of unshared address›
          ¬ volatile  (j < length 𝒪s. ij  a  dom (ℛs!j));
          volatile  ¬ 𝒟 
        
        𝒪s,ℛs,i(Read volatile a t # is, θ, m, 𝒟, 𝒪, 𝒮)"

| WriteNonVolatile:
  "a  𝒪; a  dom 𝒮; j < length 𝒪s. ij  a  dom (ℛs!j) 
   
   𝒪s,ℛs,i(Write False a (D,f) A L R W#is, θ, m, 𝒟, 𝒪, 𝒮)"

| WriteVolatile:
  "j < length 𝒪s. ij  a  (𝒪s!j  dom (ℛs!j));     
    A  dom 𝒮  𝒪; L  A; R  𝒪; A  R = {}; 
    j < length 𝒪s. ij   A   (𝒪s!j  dom (ℛs!j)) = {};
   a  read_only 𝒮
    
   𝒪s,ℛs,i(Write True a (D,f) A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"

| Fence:
  "𝒪s,ℛs,i(Fence # is, θ, m, 𝒟, 𝒪, 𝒮)"

| Ghost:
  "A  dom 𝒮  𝒪; L  A; R  𝒪; A  R = {}; 
    j < length 𝒪s. ij   A  (𝒪s!j  dom (ℛs!j)) = {}
    
   𝒪s,ℛs,i(Ghost A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"

| RMWReadOnly:
  "¬ cond (θ(tm a)); a  𝒪  a  dom 𝒮; 
   j < length 𝒪s. ij  (ℛs!j) a  Some False ― ‹no release of unshared address›
    
   𝒪s,ℛs,i(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"

| RMWWrite:
  "cond (θ(tm a));  a  𝒪  a  dom 𝒮; 
    j < length 𝒪s. ij  a  (𝒪s!j  dom (ℛs!j));
    A  dom 𝒮  𝒪; L  A; R  𝒪; A  R = {}; 
    j < length 𝒪s. ij  A  (𝒪s!j  dom (ℛs!j))  = {};
    a  read_only 𝒮 
    
   𝒪s,ℛs,i(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"

| Nil:   "𝒪s,ℛs,i([], θ, m, 𝒟, 𝒪, 𝒮)"

lemma memop_safe_delayed_implies_safe_free_flowing: 
  assumes safe_delayed: "𝒪s,ℛs,i(is, θ, m, 𝒟, 𝒪, 𝒮)"
  shows "𝒪s,i(is, θ, m, 𝒟, 𝒪, 𝒮)"
using safe_delayed
proof (cases)
  case Read thus ?thesis
    by (fastforce intro!: safe_direct_memop_state.intros)
next
  case WriteNonVolatile thus ?thesis
    by (fastforce intro!: safe_direct_memop_state.intros)
next
  case WriteVolatile thus ?thesis
    by (fastforce intro!: safe_direct_memop_state.intros)
next
  case Fence thus ?thesis
    by (fastforce intro!: safe_direct_memop_state.intros)
next
  case Ghost thus ?thesis
  by (fastforce intro!: safe_direct_memop_state.Ghost)
next
  case RMWReadOnly thus ?thesis
    by (fastforce intro!: safe_direct_memop_state.intros)
next
  case RMWWrite thus ?thesis
    by (fastforce intro!: safe_direct_memop_state.RMWWrite)
next
  case Nil thus ?thesis
    by (fastforce intro!: safe_direct_memop_state.Nil)
qed

lemma memop_empty_rels_safe_free_flowing_implies_safe_delayed: 
  assumes safe: "𝒪s,i(is, θ, m, 𝒟, 𝒪, 𝒮)" 
  assumes empty: "  set ℛs.  = Map.empty"
  assumes leq: "length 𝒪s = length ℛs"
  assumes unowned_shared: "(a. (i < length 𝒪s. a  (𝒪s!i))  a  dom 𝒮)"
  assumes Os_i: "𝒪s!i = 𝒪"
  shows "𝒪s,ℛs,i(is, θ, m, 𝒟, 𝒪, 𝒮)"
using safe
proof (cases)
  case Read thus ?thesis
    using leq empty
    by (fastforce intro!: safe_delayed_direct_memop_state.Read dest: nth_mem)
next
  case WriteNonVolatile thus ?thesis
    using leq empty
    by (fastforce intro!: safe_delayed_direct_memop_state.intros dest: nth_mem)
next
  case WriteVolatile thus ?thesis
  using leq empty
    apply clarsimp
    apply (rule safe_delayed_direct_memop_state.WriteVolatile)
    apply (auto)
    apply  (drule nth_mem)
    apply  fastforce
    apply (drule nth_mem)
    apply fastforce
    done
next
  case Fence thus ?thesis
    by (fastforce intro!: safe_delayed_direct_memop_state.intros)
next
  case Ghost thus ?thesis
  using leq empty
    apply clarsimp
    apply (rule safe_delayed_direct_memop_state.Ghost)
    apply (auto)
    apply (drule nth_mem)
    apply fastforce
    done
next
  case RMWReadOnly thus ?thesis
  using leq empty
    by (fastforce intro!: safe_delayed_direct_memop_state.intros dest: nth_mem)
next
  case (RMWWrite cond t a A L R D f ret W) thus ?thesis
  using leq empty unowned_shared [rule_format, where a=a] Os_i
    apply clarsimp
    apply (rule safe_delayed_direct_memop_state.RMWWrite)
    apply (auto)
    apply  (drule nth_mem)
    apply  fastforce
    apply (drule nth_mem)
    apply fastforce
    done
next
  case Nil thus ?thesis
    by (fastforce intro!: safe_delayed_direct_memop_state.Nil)
qed


inductive id_storebuffer_step:: 
  "(memory × unit × owns × rels × shared)  (memory × unit × owns × rels × shared)  bool" ("_ I _" [60,60] 100)
where
  Id: "(m,x,𝒪,,𝒮) I (m,x,𝒪,,𝒮)"

definition empty_storebuffer_step:: "(memory × 'sb × 'owns × 'rels × 'shared)  (memory × 'sb × 'owns × 'rels × 'shared)  bool"
where
"empty_storebuffer_step c c' = False"

context program
begin

abbreviation direct_concurrent_step ::
  "('p,unit,bool,owns,rels,shared) global_config  ('p,unit,bool,owns,rels,shared) global_config  bool"
   ("_ d _" [100,60] 100)
where
  "direct_concurrent_step  
     computation.concurrent_step direct_memop_step.gen_direct_memop_step empty_storebuffer_step program_step
      (λp p' is sb. sb)"

abbreviation direct_concurrent_steps::  
  "('p,unit,bool,owns,rels,shared) global_config  ('p,unit,bool,owns,rels,shared) global_config  bool" 
    ("_ d* _" [60,60] 100)
where
"direct_concurrent_steps == direct_concurrent_step^**"  

abbreviation virtual_concurrent_step ::
  "('p,unit,bool,owns,unit,shared) global_config  ('p,unit,bool,owns,unit,shared) global_config  bool"
   ("_ v _" [100,60] 100)
where
  "virtual_concurrent_step  
     computation.concurrent_step virtual_memop_step.gen_direct_memop_step empty_storebuffer_step program_step
      (λp p' is sb. sb)"

abbreviation virtual_concurrent_steps::  
  "('p,unit,bool,owns,unit,shared) global_config  ('p,unit,bool,owns,unit,shared) global_config  bool" 
    ("_ v* _" [60,60] 100)
where
"virtual_concurrent_steps == virtual_concurrent_step^**"  

(* check if abbreviations work in both directions *)
term "x v Y"
term "x d Y"

term "x d* Y"
term "x v* Y"

end

definition
 "safe_reach step safe cfg  
        cfg'. step^** cfg cfg'  safe cfg'"

lemma safe_reach_safe_refl: "safe_reach step safe cfg  safe cfg"       
  apply (auto simp add: safe_reach_def)
  done

lemma safe_reach_safe_rtrancl: "safe_reach step safe cfg  step^** cfg cfg'  safe cfg'"       
  by (simp only: safe_reach_def)

lemma safe_reach_steps: "safe_reach step safe cfg  step^** cfg cfg'  safe_reach step safe  cfg'" 
  apply (auto simp add: safe_reach_def intro: rtranclp_trans)
  done
  
lemma safe_reach_step: "safe_reach step safe cfg  step cfg cfg'  safe_reach step safe cfg'"
  apply (erule safe_reach_steps)
  apply (erule r_into_rtranclp)
  done

context program
begin

abbreviation
 "safe_reach_direct  safe_reach direct_concurrent_step"

lemma safe_reac_direct_def':
 "safe_reach_direct safe cfg  
        cfg'. cfg d* cfg'  safe cfg'"
  by( simp add: safe_reach_def)

abbreviation
 "safe_reach_virtual  safe_reach virtual_concurrent_step"

lemma safe_reac_virtual_def':
 "safe_reach_virtual safe cfg  
        cfg'. cfg v* cfg'  safe cfg'"
  by( simp add: safe_reach_def)
end

definition
 "safe_free_flowing cfg  let (ts,m,𝒮) = cfg 
             in (i < length ts. let (p,is,θ,x,𝒟,𝒪,) = ts!i in 
                 map owned ts,i (is,θ,m,𝒟,𝒪,𝒮))"

lemma safeE: "safe_free_flowing (ts,m,𝒮);i<length ts; ts!i=(p,is,θ,x,𝒟,𝒪,)
               map owned ts,i (is,θ,m,𝒟,𝒪,𝒮)"
  by (auto simp add: safe_free_flowing_def)

definition
 "safe_delayed cfg  let (ts,m,𝒮) = cfg 
             in (i < length ts. let (p,is,θ,x,𝒟,𝒪,) = ts!i in 
                 map owned ts,map released ts,i (is,θ,m,𝒟,𝒪,𝒮))"

lemma safe_delayedE: "safe_delayed (ts,m,𝒮);i<length ts; ts!i=(p,is,θ,x,𝒟,𝒪,)
               map owned ts,map released ts,i (is,θ,m,𝒟,𝒪,𝒮)"
  by (auto simp add: safe_delayed_def)

definition "remove_rels   map (λ(p,is,θ,sb,𝒟,𝒪,). (p,is,θ,sb,𝒟,𝒪,()))"

theorem (in program) virtual_simulates_direct_step:
  assumes step: "(ts,m,𝒮) d (ts',m',𝒮')"
  shows "(remove_rels ts,m,𝒮) v (remove_rels ts',m',𝒮')"
using step
proof -
  interpret direct_computation:
    computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
  interpret virtual_computation:
    computation virtual_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
  from step show ?thesis
  proof (cases)
    case (Program j p "is" θ sb 𝒟 𝒪  p' is')
    then obtain
      ts': "ts' = ts[j:=(p',is@is',θ,sb,𝒟,𝒪,)]" and
      𝒮': "𝒮'=𝒮" and
      m': "m'=m" and
      j_bound: "j < length ts" and
      ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,)" and
      prog_step: "θ p p (p', is')"
      by auto
    from ts_j j_bound have 
      vts_j: "remove_rels ts!j = (p,is,θ,sb,𝒟,𝒪,())" by (auto simp add: remove_rels_def)
    
    from virtual_computation.Program [OF _ vts_j prog_step, of m 𝒮] j_bound ts'
    show ?thesis
      by (clarsimp simp add: 𝒮' m' remove_rels_def map_update)
  next
    case (Memop j p "is" θ sb 𝒟 𝒪  is' θ' sb' 𝒟' 𝒪' ℛ')
    then obtain
      ts': "ts' = ts[j:=(p,is',θ',sb',𝒟',𝒪',ℛ')]" and
      j_bound: "j < length ts" and
      ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,)"  and
      mem_step: "(is, θ, sb, m, 𝒟, 𝒪, , 𝒮)  (is', θ', sb',m', 𝒟',  𝒪', ℛ', 𝒮')"
      by auto

    from ts_j j_bound have 
      vts_j: "remove_rels ts!j = (p,is,θ,sb,𝒟,𝒪,())" by (auto simp add: remove_rels_def)

    from virtual_computation.Memop[OF _ vts_j virtual_memop_step_simulates_direct_memop_step [OF mem_step]] j_bound ts'
    show ?thesis
      by (clarsimp simp add: remove_rels_def map_update)
  next
    case (StoreBuffer _ p "is" θ sb 𝒟 𝒪  sb' 𝒪' ℛ')
    hence False 
      by (auto simp add: empty_storebuffer_step_def)
    thus ?thesis ..
  qed
qed

lemmas converse_rtranclp_induct_sbh_steps = converse_rtranclp_induct
[of _ "(ts,m,𝒮)" "(ts',m',𝒮')", split_rule,
   consumes 1, case_names refl step]


theorem (in program) virtual_simulates_direct_steps:
  assumes steps: "(ts,m,𝒮) d* (ts',m',𝒮')"
  shows "(remove_rels ts,m,𝒮) v* (remove_rels ts',m',𝒮')"
using steps
proof (induct rule: converse_rtranclp_induct_sbh_steps)
  case refl thus ?case by auto
next
  case (step ts m 𝒮 ts'' m'' 𝒮'')
  then obtain 
    first: "(ts, m, 𝒮) d (ts'', m'', 𝒮'')" and
    hyp: "(remove_rels ts'', m'', 𝒮'') v* (remove_rels ts', m', 𝒮')"
    by blast
  note virtual_simulates_direct_step [OF first] also note hyp
  finally
  show ?case by blast
qed

locale simple_ownership_distinct =
fixes ts::"('p,'sb,'dirty,owns,'rels) thread_config list"
assumes simple_ownership_distinct:
   "i j pi isi 𝒪i i 𝒟i θi sbi pj isj 𝒪j j 𝒟j θj sbj. 
      i < length ts; j < length ts; i  j; 
    ts!i = (pi,isi,θi,sbi,𝒟i,𝒪i,i); ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)
        𝒪i  𝒪j = {}"

lemma (in simple_ownership_distinct)
  simple_ownership_distinct_nth_update:
 "i p is θ 𝒪  𝒟 xs sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,);
    j < length ts. ij  (let (pj,isj,θj,sbj,𝒟j,𝒪j,j) = ts!j 
          in (𝒪')  (𝒪j) ={})   
     simple_ownership_distinct (ts[i := (p',is',θ',sb',𝒟',𝒪',ℛ')])"
  apply (unfold_locales)
  apply (clarsimp simp add: nth_list_update split: if_split_asm)
  apply   (force dest: simple_ownership_distinct simp add: Let_def)
  apply  (fastforce dest: simple_ownership_distinct simp add: Let_def)
  apply (fastforce dest: simple_ownership_distinct simp add: Let_def)
  done

locale read_only_unowned =
fixes 𝒮::shared and ts::"('p,'sb,'dirty,owns,'rels) thread_config list"
assumes read_only_unowned:
  "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)  
   
   𝒪  read_only 𝒮 = {}"

lemma (in read_only_unowned)
  read_only_unowned_nth_update:
 "i p is 𝒪  𝒟 acq θ sb. 
   i < length ts; 𝒪  read_only 𝒮  = {}  
     read_only_unowned 𝒮 (ts[i := (p,is,θ,sb,𝒟,𝒪,)])"
  apply (unfold_locales)
  apply   (auto dest: read_only_unowned
       simp add:  nth_list_update split: if_split_asm)
  done

locale unowned_shared =
fixes 𝒮::shared and ts::"('p,'sb,'dirty,owns,'rels) thread_config list"
assumes unowned_shared: "-  ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts)  dom 𝒮"

lemma (in unowned_shared)
  unowned_shared_nth_update:
  assumes i_bound: "i < length ts" 
  assumes ith: "ts!i=(p,is,xs,sb,𝒟,𝒪,)" 
  assumes subset: "𝒪   𝒪'"
  shows "unowned_shared 𝒮 (ts[i := (p',is',xs',sb',𝒟',𝒪',ℛ')])"
proof -
  from i_bound ith subset
  have " ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts)  
         ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set (ts[i := (p',is',xs',sb',𝒟',𝒪',ℛ')]))"

    apply (auto simp add: in_set_conv_nth nth_list_update split: if_split_asm)
    subgoal for x p'' is'' xs'' sb'' 𝒟''  𝒪'' ℛ'' j
    apply (case_tac "j=i")
    apply  (rule_tac x="(p',is',xs',sb',𝒟',𝒪',ℛ')" in bexI)
    apply   fastforce
    apply  (fastforce simp add: in_set_conv_nth)
    apply (rule_tac x="(p'',is'',xs'',sb'',𝒟'',𝒪'',ℛ'')" in bexI)
    apply  fastforce
    apply (fastforce simp add: in_set_conv_nth)
    done 
    done
  hence "-  ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set (ts[i := (p',is',xs',sb',𝒟',𝒪',ℛ')]))  
         -  ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts)"
    by blast
  also note unowned_shared
  finally
  show ?thesis
    by (unfold_locales)
qed

lemma (in unowned_shared) a_unowned_by_others_owned_or_shared:
  assumes i_bound: "i < length ts"
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
  assumes a_unowned_others:
        "j<length (map owned ts). i  j  
          (let 𝒪j = (map owned ts)!j in a  𝒪j)" 

  shows "a  𝒪  a  dom 𝒮"
proof -
  {
    fix j pj isj 𝒪j j 𝒟j xsj sbj
    assume a_unowned: "a  𝒪"
    assume j_bound: "j < length ts"
    assume jth: "ts!j = (pj,isj,xsj, sbj, 𝒟j, 𝒪j,j)"
    have "a  𝒪j"
    proof (cases "i=j")
      case True with a_unowned ts_i jth
      show ?thesis
	by auto
    next
      case False
      from a_unowned_others [rule_format, of j] j_bound jth False
      show ?thesis
	by auto
    qed
  } note lem = this
  {
    assume "a  𝒪"
    from lem [OF this]
    have "a   -  ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts)"
      by (fastforce simp add: in_set_conv_nth)
    with unowned_shared have "a  dom 𝒮"
      by auto
  } 
  then
  show ?thesis
    by auto
qed

lemma (in unowned_shared) unowned_shared': 
  assumes notin: "i < length ts. a  owned (ts!i)"
  shows "a  dom 𝒮"
proof -
  from notin  have "a  - ((λ(_, _, _, _, _, 𝒪, _). 𝒪) ` set ts)"
    by (force simp add: in_set_conv_nth)
  with unowned_shared show ?thesis by blast
qed

lemma unowned_shared_def': "unowned_shared 𝒮 ts = (a. (i < length ts. a  owned (ts!i))  a  dom 𝒮)"
apply rule
apply  clarsimp
apply (rule unowned_shared.unowned_shared')
apply   fastforce
apply  fastforce
apply (unfold unowned_shared_def)
apply clarsimp
subgoal for x
apply (drule_tac x=x in spec)
apply (erule impE)
apply  clarsimp
apply  (case_tac "(ts!i)")
apply  (drule nth_mem)
apply auto
done
done 

definition
 "initial cfg  let (ts,m,𝒮) = cfg 
             in unowned_shared 𝒮 ts 
                (i < length ts. let (p,is,θ,x,𝒟,𝒪,) = ts!i in 
                   = Map.empty )"

lemma initial_empty_rels: "initial (ts,m,𝒮)    set (map released ts).  = Map.empty"
  by (fastforce simp add: initial_def simp add: in_set_conv_nth)

lemma initial_unowned_shared: "initial (ts,m,𝒮)  unowned_shared 𝒮 ts"
  by (fastforce simp add: initial_def )

lemma initial_safe_free_flowing_implies_safe_delayed:
assumes init: "initial c" 
assumes safe: "safe_free_flowing c"
shows "safe_delayed c"
proof -
  obtain ts 𝒮 m where c: "c=(ts,m,𝒮)" by (cases c)
  from initial_empty_rels [OF init [simplified c]]
  have rels_empty: "set (map released ts).  = Map.empty".
  from initial_unowned_shared [OF init [simplified c]] have "unowned_shared 𝒮 ts"
    by auto
  hence us:"(a. (i < length (map owned ts). a  (map owned ts!i))  a  dom 𝒮)"
    by (simp add:unowned_shared_def')
  {
    fix i p "is" θ x 𝒟 𝒪 
    assume i_bound: "i < length ts"
    assume ts_i: "ts!i = (p,is,θ,x,𝒟,𝒪,)"
    have "map owned ts,map released ts,i (is,θ,m,𝒟,𝒪,𝒮)"
    proof -
      from safeE [OF safe [simplified c] i_bound ts_i] 
      have "map owned ts,i(is, θ, m, 𝒟, 𝒪, 𝒮)".
      from memop_empty_rels_safe_free_flowing_implies_safe_delayed [OF this rels_empty _ us] i_bound ts_i
      show ?thesis
        by simp
    qed
  }
  then show ?thesis 
    by (fastforce simp add: c safe_delayed_def)
qed


locale program_progress = program +
assumes progress: "θ p p (p',is')  p'  p  is'  []"
text ‹The assumption `progress' could be avoided if we introduce stuttering steps in lemma undo_local_step›
or make the scheduling of threads explicit, such that we can directly express that `thread i does not make a step'.
›

lemma (in program_progress) undo_local_step:
assumes step: "(ts,m,𝒮) d (ts',m',𝒮')"
assumes i_bound: "i < length ts"
assumes unchanged: "ts!i = ts'!i"
assumes safe_delayed_undo: "safe_delayed (u_ts,u_m,u_shared)" ― ‹proof should also work with weaker @{const safe_free_flowing}
assumes leq: "length u_ts = length ts"
assumes others_same: "j < length ts. ji  u_ts!j = ts!j"
assumes u_ts_i: "u_ts!i=(u_p,u_is,u_tmps,u_x,u_dirty,u_owns,u_rels)"
assumes u_m_other: "a. a  u_owns  u_m a = m a"
assumes u_m_shared: "a. a  u_owns  a  dom u_shared  u_m a = m a"
assumes u_shared: "a. a  u_owns  a  owned (ts!i)  u_shared a = 𝒮 a"
assumes dist: "simple_ownership_distinct u_ts"
assumes dist_ts: "simple_ownership_distinct ts"
shows "u_ts' u_shared' u_m'. (u_ts,u_m,u_shared) d (u_ts',u_m',u_shared') 
         ― ‹thread i is unchanged›
         u_ts'!i = u_ts!i 
         (a  u_owns. u_shared' a = u_shared a) 
         (a  u_owns. 𝒮' a = 𝒮 a) 
         (a  u_owns. u_m' a = u_m a) 
         (a  u_owns. m' a = m a) 

         ― ‹other threads are simulated›
         (j < length ts. ji  u_ts'!j = ts'!j) 
         (a. a  u_owns  a  owned (ts!i)  u_shared' a = 𝒮' a) 
         (a. a  u_owns  u_m' a = m' a)"
proof -
  interpret direct_computation:
    computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
  from dist interpret simple_ownership_distinct u_ts .
  from step
  show ?thesis
  proof (cases)
    case (Program j p "is" θ sb 𝒟 𝒪  p' is')
    then obtain
      ts': "ts' = ts[j:=(p',is@is',θ,sb,𝒟,𝒪,)]" and
      𝒮': "𝒮'=𝒮" and
      m': "m'=m" and
      j_bound: "j < length ts" and
      ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,)" and
      prog_step: "θ p p (p', is')"
      by auto

    from progress [OF prog_step] i_bound unchanged ts_j ts'
    have neq_j_i: "ji"
      by auto


    from others_same [rule_format, OF j_bound neq_j_i] ts_j
    have u_ts_j: "u_ts!j = (p,is,θ,sb,𝒟,𝒪,)"
      by simp
    from leq j_bound have j_bound': "j < length u_ts"
      by simp
    from leq i_bound have i_bound': "i < length u_ts"
      by simp

    from direct_computation.Program [OF j_bound' u_ts_j prog_step]
    have ustep:" (u_ts,u_m, u_shared) d (u_ts[j := (p', is @ is', θ, sb, 𝒟, 𝒪, )], u_m, u_shared)".  show ?thesis
      apply -
      apply (rule exI)
      apply (rule exI)
      apply (rule exI)
      apply (rule conjI)
      apply (rule ustep)
      using neq_j_i others_same u_m_other u_shared j_bound leq ts_j 
      apply (auto simp add: nth_list_update ts' 𝒮' m')
      done
  next
    case (Memop j p "is" θ sb 𝒟 𝒪  is' θ' sb' 𝒟' 𝒪' ℛ')
    then obtain
      ts': "ts' = ts[j:=(p,is',θ',sb',𝒟',𝒪',ℛ')]" and
      j_bound: "j < length ts" and
      ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,)"  and
      mem_step: "(is, θ, sb, m, 𝒟, 𝒪, , 𝒮)  (is', θ', sb',m', 𝒟',  𝒪', ℛ', 𝒮')"
      by auto

    from mem_step i_bound unchanged ts_j
    have neq_j_i: "ji"
      by cases (auto simp add: ts')

    from others_same [rule_format, OF j_bound neq_j_i] ts_j
    have u_ts_j: "u_ts!j = (p,is,θ,sb,𝒟,𝒪,)"
      by simp
    from leq j_bound have j_bound': "j < length u_ts"
      by simp
    from leq i_bound have i_bound': "i < length u_ts"
      by simp
    from safe_delayedE [OF safe_delayed_undo j_bound' u_ts_j]
    have safe_j: "map owned u_ts,map released u_ts,j(is, θ, u_m, 𝒟, 𝒪, u_shared)".
    from simple_ownership_distinct [OF j_bound' i_bound' neq_j_i u_ts_j u_ts_i]
    have owns_u_owns: "𝒪  u_owns = {}" .
    from mem_step
    show ?thesis
    proof (cases)
      case (Read volatile a t)
      then obtain
        "is": "is = Read volatile a t # is'" and
        θ': "θ' = θ(t  m a)" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from safe_j [simplified "is"]
      obtain 
        access_cond: "a  𝒪  a  read_only u_shared  
                   (volatile  a  dom u_shared)" 
      
        and
        clean: "volatile  ¬ 𝒟"
        by cases auto
      have u_m_a_eq: "u_m a = m a"
      proof (cases "a  u_owns")
        case True
        with simple_ownership_distinct [OF j_bound' i_bound' neq_j_i u_ts_j u_ts_i]
        have "a  𝒪" by auto
        with access_cond read_only_dom [of u_shared] have "a  dom u_shared"
          by auto
        from u_m_shared [rule_format, OF True this] 
        show ?thesis .
      next
        case False
        from u_m_other [rule_format, OF this]
        show ?thesis .
      qed
      note Read' = direct_memop_step.Read [of volatile a t "is'" θ sb u_m 𝒟 𝒪  u_shared]
      from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Read' ] 
      have ustep: "(u_ts, u_m, u_shared) d (u_ts[j := (p, is', θ(t  u_m a), sb, 𝒟, 𝒪, )], u_m, u_shared)".
      show ?thesis
        apply -
        apply (rule exI)
        apply (rule exI)
        apply (rule exI)
        apply (rule conjI)
        apply (rule ustep)
        using neq_j_i others_same u_m_other u_shared j_bound leq ts_j 
        by (auto simp add: nth_list_update ts' eqs' u_m_a_eq)
    next
      case (WriteNonVolatile a D f A L R W)
      then obtain
        "is": "is = Write False a (D, f) A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m(a:=f θ)" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from safe_j [simplified "is"]
      obtain
        owned: "a  𝒪" and unshared: "a  dom u_shared"
        by cases auto

      from simple_ownership_distinct [OF j_bound' i_bound' neq_j_i u_ts_j u_ts_i] owned
      have a_unowned_i: "a  u_owns"
        by auto
      note Write' = direct_memop_step.WriteNonVolatile [of a D f A L R W is' θ sb u_m 𝒟 𝒪  u_shared]
      from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Write' ] 
      have ustep: "(u_ts, u_m, u_shared) d (u_ts[j := (p, is', θ, sb, 𝒟, 𝒪, )], u_m (a := f θ), u_shared)".
      show ?thesis
        apply -
        apply (rule exI)
        apply (rule exI)
        apply (rule exI)
        apply (rule conjI)
        apply (rule ustep)
        using neq_j_i others_same u_m_other u_shared j_bound leq ts_j a_unowned_i
        apply (auto simp add: nth_list_update ts' eqs')
        done
    next
      case (WriteVolatile a D f A L R W)
      then obtain
        "is": "is = Write True a (D, f) A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m(a:=f θ)" and
        𝒟': "𝒟'=True" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮W RA L"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from safe_j [simplified "is"]
      obtain
        a_unowned_others: "k < length u_ts. jk  a  (map owned u_ts!k  dom (map released u_ts!k))" and
        A: "A  dom u_shared  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length u_ts. jk   A   (map owned u_ts!k  dom (map released u_ts!k)) = {}" and
        a_not_ro: "a  read_only u_shared"
        by cases auto

      note Write' = direct_memop_step.WriteVolatile [of a D f A L R W is' θ sb u_m 𝒟 𝒪  u_shared]
      from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Write' ] 
      have ustep: "(u_ts, u_m, u_shared) d 
                   (u_ts[j := (p, is', θ, sb, True, 𝒪  A - R, Map.empty)], u_m (a := f θ), u_sharedW RA L)".

      from A_unowned_others [rule_format, OF i_bound' neq_j_i] u_ts_i i_bound' 
      have A_u_owns: "A  u_owns = {}" by auto
      {
        fix a
        assume a_u_owns: "a  u_owns"
        have "(u_sharedW RA L) a = u_shared a"
        using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
          by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
      }
      note u_owned_shared = this
      from a_unowned_others [rule_format, OF i_bound' neq_j_i] u_ts_i i_bound'  have a_u_owns: "a  u_owns" by auto
      {
        fix a
        assume a_u_owns: "a  u_owns"
        assume a_u_owns_orig: "a  owned (ts!i)"
        from u_shared [rule_format, OF a_u_owns a_u_owns_orig]
        have "(u_sharedW RA L) a = (𝒮W RA L) a"
        using R_owns A_R L_A A_u_owns owns_u_owns 
          by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
      }
      note u_unowned_shared = this
      {
        fix a
        assume a_u_owns: "a  u_owns"

        have "(𝒮W RA L) a = 𝒮 a"
        using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
          by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
      }
      note 𝒮'_shared = this

      show ?thesis
        apply -
        apply (rule exI)
        apply (rule exI)
        apply (rule exI)
        apply (rule conjI)
        apply (rule ustep)
        using neq_j_i others_same u_m_other u_shared j_bound leq ts_j u_owned_shared a_u_owns u_unowned_shared 𝒮'_shared
        apply (auto simp add: nth_list_update ts' eqs')
        done
    next      
      case Fence
      then obtain
        "is": "is = Fence # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      note Fence' = direct_memop_step.Fence [of is' θ sb u_m 𝒟 𝒪  u_shared]
      from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Fence' ] 
      have ustep: "(u_ts, u_m, u_shared) d (u_ts[j := (p, is', θ, sb, False, 𝒪, Map.empty)], u_m, u_shared)".
      show ?thesis
        apply -
        apply (rule exI)
        apply (rule exI)
        apply (rule exI)
        apply (rule conjI)
        apply (rule ustep)
        using neq_j_i others_same u_m_other u_shared j_bound leq ts_j 
        by (auto simp add: nth_list_update ts' eqs' )
    next
      case (RMWReadOnly cond t a D f ret A L R W)
      then obtain
        "is": "is = RMW a t (D, f) cond ret A L R W # is'" and
        θ': "θ' = θ(t m a)" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮" and
        cond: "¬ cond (θ(t  m a))"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      from safe_j [simplified "is"] owns_u_owns u_ts_i i_bound' neq_j_i
      obtain 
        access_cond: "a  u_owns  (a  dom u_shared  a  u_owns)"
        by cases auto
        
      from u_m_other u_m_shared access_cond
      have u_m_a_eq: "u_m a = m a"
        by auto
      from cond u_m_a_eq have cond': "¬ cond (θ(t  u_m a))"
        by auto
      note RMWReadOnly' = direct_memop_step.RMWReadOnly [of cond θ t u_m a D f ret A L R W is' sb 𝒟 𝒪  u_shared, 
        OF cond']
      from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF RMWReadOnly' ] 
      have ustep: "(u_ts, u_m, u_shared) d (u_ts[j := (p, is', θ(t  u_m a), sb, False, 𝒪, Map.empty)], u_m, u_shared)".
      show ?thesis
        apply -
        apply (rule exI)
        apply (rule exI)
        apply (rule exI)
        apply (rule conjI)
        apply (rule ustep)
        using neq_j_i others_same u_m_other u_shared j_bound leq ts_j
        by (auto simp add: nth_list_update ts' eqs' u_m_a_eq)
    next
      case (RMWWrite cond t a D f ret A L R W)
      then obtain
        "is": "is = RMW a t (D, f) cond ret A L R W # is'" and
        θ': "θ' = θ(t  ret (m a) (f (θ(t  m a))))" and
        sb': "sb'=sb" and
        m': "m'=m(a := f (θ(t  m a)))" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮W RA L" and
        cond: "cond (θ(t  m a))"
        by auto

      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      from safe_j [simplified "is"] owns_u_owns u_ts_i i_bound' neq_j_i
      obtain 
        access_cond: "a  u_owns  (a  dom u_shared  a  u_owns)"
        by cases auto
        
      from u_m_other u_m_shared access_cond
      have u_m_a_eq: "u_m a = m a"
        by auto
      from cond u_m_a_eq have cond': "cond (θ(t  u_m a))"
        by auto
      from safe_j [simplified "is"] cond'
      obtain
        a_unowned_others: "k < length u_ts. jk  a  (map owned u_ts!k  dom (map released u_ts!k))" and
        A: "A  dom u_shared  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length u_ts. jk   A   (map owned u_ts!k  dom (map released u_ts!k)) = {}" and
        a_not_ro: "a  read_only u_shared"
        by cases auto

      note Write' = direct_memop_step.RMWWrite [of cond θ t u_m a D f ret A L R W is' sb 𝒟 𝒪  u_shared, 
        OF cond']
      from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Write' ] 
      have ustep: "(u_ts, u_m, u_shared) d 
                   (u_ts[j := (p, is', θ(t  ret (u_m a) (f (θ(t  u_m a)))), sb, False, 𝒪  A - R, Map.empty)], u_m(a := f (θ(t  u_m a))), 
                    u_sharedW RA L)".

      from A_unowned_others [rule_format, OF i_bound' neq_j_i] u_ts_i i_bound' 
      have A_u_owns: "A  u_owns = {}" by auto
      {
        fix a
        assume a_u_owns: "a  u_owns"
        have "(u_sharedW RA L) a = u_shared a"
        using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
          by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
      }
      note u_owned_shared = this
      from a_unowned_others [rule_format, OF i_bound' neq_j_i] u_ts_i i_bound'  have a_u_owns: "a  u_owns" by auto
      {
        fix a
        assume a_u_owns: "a  u_owns"
        assume a_u_owns_orig: "a  owned (ts!i)"
        from u_shared [rule_format, OF a_u_owns this]
        have "(u_sharedW RA L) a = (𝒮W RA L) a"
        using R_owns A_R L_A A_u_owns owns_u_owns 
          by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
      }
      note u_unowned_shared = this
      {
        fix a
        assume a_u_owns: "a  u_owns"

        have "(𝒮W RA L) a = 𝒮 a"
        using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
          by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
      }
      note 𝒮'_shared = this
      show ?thesis
        apply -
        apply (rule exI)
        apply (rule exI)
        apply (rule exI)
        apply (rule conjI)
        apply (rule ustep)
        using neq_j_i others_same u_m_other u_shared j_bound leq ts_j u_owned_shared a_u_owns u_unowned_shared 𝒮'_shared
        apply (auto simp add: nth_list_update ts' eqs')
        done
    next
      case (Ghost A L R W) 
      then obtain
        "is": "is = Ghost A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=augment_rels (dom 𝒮) R " and
        𝒮': "𝒮'=𝒮W RA L"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from safe_j [simplified "is"]
      obtain
        A: "A  dom u_shared  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length u_ts. jk   A   (map owned u_ts!k  dom (map released u_ts!k)) = {}" 
        by cases auto

      note Ghost' = direct_memop_step.Ghost [of A L R W is' θ sb u_m 𝒟 𝒪  u_shared]
      from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Ghost' ] 
      have ustep: "(u_ts, u_m, u_shared) d 
                   (u_ts[j := (p, is', θ, sb, 𝒟, 𝒪  A - R, augment_rels (dom u_shared) R  )], u_m, 
                          u_sharedW RA L)".

      from A_unowned_others [rule_format, OF i_bound' neq_j_i] u_ts_i i_bound' 
      have A_u_owns: "A  u_owns = {}" by auto
      {
        fix a
        assume a_u_owns: "a  u_owns"
        have "(u_sharedW RA L) a = u_shared a"
        using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
          by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
      }
      note u_owned_shared = this
      {
        fix a
        assume a_u_owns: "a  u_owns"
        assume "a  owned (ts!i)"
        from u_shared [rule_format, OF a_u_owns this]
        have "(u_sharedW RA L) a = (𝒮W RA L) a"
        using R_owns A_R L_A A_u_owns owns_u_owns 
          by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
      }
      note u_unowned_shared = this

      {
        fix a
        assume a_u_owns: "a  u_owns"

        have "(𝒮W RA L) a = 𝒮 a"
        using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
          by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
      }
      note 𝒮'_shared = this

      from dist_ts
      interpret dist_ts_inter: simple_ownership_distinct ts .
      from dist_ts_inter.simple_ownership_distinct [OF j_bound i_bound neq_j_i ts_j] 
      have "𝒪  owned (ts!i) = {}"
        apply (cases "ts!i")
        apply fastforce+
        done
      
      with simple_ownership_distinct [OF j_bound' i_bound' neq_j_i u_ts_j u_ts_i] R_owns u_shared

      have augment_eq: "augment_rels (dom u_shared) R  = augment_rels (dom 𝒮) R "
        apply -
        apply (rule ext)
        apply (fastforce simp add: augment_rels_def split: option.splits simp add: domIff)        
        done
        
        
      show ?thesis
        apply -
        apply (rule exI)
        apply (rule exI)
        apply (rule exI)
        apply (rule conjI)
        apply (rule ustep)
        using neq_j_i others_same u_m_other u_shared j_bound leq ts_j u_owned_shared u_unowned_shared 𝒮'_shared
        apply (auto simp add: nth_list_update ts' eqs' augment_eq)
        done
    qed
  next
    case (StoreBuffer _ p "is" θ sb 𝒟 𝒪  sb' 𝒪' ℛ')
    hence False 
      by (auto simp add: empty_storebuffer_step_def)
    thus ?thesis ..
  qed
qed


theorem (in program) safe_step_preserves_simple_ownership_distinct:
  assumes step: "(ts,m,𝒮) d (ts',m',𝒮')"
  assumes safe: "safe_delayed (ts,m,𝒮)"
  assumes dist: "simple_ownership_distinct ts"
  shows "simple_ownership_distinct ts'"
proof -
  interpret direct_computation:
    computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
  from dist interpret simple_ownership_distinct ts .
  from step
  show ?thesis
  proof (cases)
    case (Program j p "is" θ sb 𝒟 𝒪  p' is')
    then obtain
      ts': "ts' = ts[j:=(p',is@is',θ,sb,𝒟,𝒪,)]" and
      𝒮': "𝒮'=𝒮" and
      m': "m'=m" and
      j_bound: "j < length ts" and
      ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,)" and
      prog_step: "θ p p (p', is')"
      by auto

    from simple_ownership_distinct [OF j_bound _ _ ts_j]
    show "simple_ownership_distinct ts'"
      apply (simp only: ts')
      apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
      apply force
      done
  next
    case (Memop j p "is" θ sb 𝒟 𝒪  is' θ' sb' 𝒟' 𝒪' ℛ')
    then obtain
      ts': "ts' = ts[j:=(p,is',θ',sb',𝒟',𝒪',ℛ')]" and
      j_bound: "j < length ts" and
      ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,)"  and
      mem_step: "(is, θ, sb, m, 𝒟, 𝒪, , 𝒮)  (is', θ', sb',m', 𝒟',  𝒪', ℛ', 𝒮')"
      by auto

    from safe_delayedE [OF safe j_bound ts_j]
    have safe_j: "map owned ts,map released ts,j(is, θ, m, 𝒟, 𝒪, 𝒮)".
    from mem_step
    show ?thesis
    proof (cases)
      case (Read volatile a t)
      then obtain
        "is": "is = Read volatile a t # is'" and
        θ': "θ' = θ(t  m a)" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from simple_ownership_distinct [OF j_bound _ _ ts_j]
      show "simple_ownership_distinct ts'"
        apply (simp only: ts' eqs')
        apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
        apply force
        done

    next
      case (WriteNonVolatile a D f A L R W)
      then obtain
        "is": "is = Write False a (D, f) A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m(a:=f θ)" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      from simple_ownership_distinct [OF j_bound _ _ ts_j]
      show "simple_ownership_distinct ts'"
        apply (simp only: ts' eqs')
        apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
        apply force
        done

    next
      case (WriteVolatile a D f A L R W)
      then obtain
        "is": "is = Write True a (D, f) A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m(a:=f θ)" and
        𝒟': "𝒟'=True" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮W RA L"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from safe_j [simplified "is"]
      obtain
        a_unowned_others: "k < length ts. jk  a  (map owned ts!k  dom (map released ts!k))" and
        A: "A  dom 𝒮  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length ts. jk   A   (map owned ts!k  dom (map released ts!k)) = {}" and
        a_not_ro: "a  read_only 𝒮"
        by cases auto
      from simple_ownership_distinct [OF j_bound _ _ ts_j] R_owns A_R A_unowned_others
      show "simple_ownership_distinct ts'"
        apply (simp only: ts' eqs')
        apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
        apply force
        done
    next      
      case Fence
      then obtain
        "is": "is = Fence # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      from simple_ownership_distinct [OF j_bound _ _ ts_j]
      show "simple_ownership_distinct ts'"
        apply (simp only: ts' eqs')
        apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
        apply force
        done
    next
      case (RMWReadOnly cond t a D f ret A L R W)
      then obtain
        "is": "is = RMW a t (D, f) cond ret A L R W # is'" and
        θ': "θ' = θ(t m a)" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮" and
        cond: "¬ cond (θ(t  m a))"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      from simple_ownership_distinct [OF j_bound _ _ ts_j]
      show "simple_ownership_distinct ts'"
        apply (simp only: ts' eqs')
        apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
        apply force
        done
    next
      case (RMWWrite cond t a D f ret A L R W)
      then obtain
        "is": "is = RMW a t (D, f) cond ret A L R W # is'" and
        θ': "θ' = θ(t  ret (m a) (f (θ(t  m a))))" and
        sb': "sb'=sb" and
        m': "m'=m(a := f (θ(t  m a)))" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮W RA L" and
        cond: "cond (θ(t  m a))"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      from safe_j [simplified "is"] cond
      obtain
        a_unowned_others: "k < length ts. jk  a  (map owned ts!k  dom (map released ts!k))" and
        A: "A  dom 𝒮  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length ts. jk   A   (map owned ts!k  dom (map released ts!k)) = {}" and
        a_not_ro: "a  read_only 𝒮"
        by cases auto

      from simple_ownership_distinct [OF j_bound _ _ ts_j] R_owns A_R A_unowned_others
      show "simple_ownership_distinct ts'"
        apply (simp only: ts' eqs')
        apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
        apply force
        done
    next
      case (Ghost A L R W) 
      then obtain
        "is": "is = Ghost A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=augment_rels (dom 𝒮) R " and
        𝒮': "𝒮'=𝒮W RA L"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from safe_j [simplified "is"]
      obtain
        A: "A  dom 𝒮  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length ts. jk   A   (map owned ts!k  dom (map released ts!k)) = {}" 
        by cases auto

      from simple_ownership_distinct [OF j_bound _ _ ts_j] R_owns A_R A_unowned_others
      show "simple_ownership_distinct ts'"
        apply (simp only: ts' eqs')
        apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
        apply force
        done
    qed
  next
    case (StoreBuffer _ p "is" θ sb 𝒟 𝒪  sb' 𝒪' ℛ')
    hence False 
      by (auto simp add: empty_storebuffer_step_def)
    thus ?thesis ..
  qed
qed

theorem (in program) safe_step_preserves_read_only_unowned:
  assumes step: "(ts,m,𝒮) d (ts',m',𝒮')"
  assumes safe: "safe_delayed (ts,m,𝒮)"
  assumes dist: "simple_ownership_distinct ts"
  assumes ro_unowned: "read_only_unowned 𝒮 ts"
  shows "read_only_unowned 𝒮' ts'"
proof -
  interpret direct_computation:
    computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
  from dist interpret simple_ownership_distinct ts .
  from ro_unowned interpret read_only_unowned 𝒮 ts .
  from step
  show ?thesis
  proof (cases)
    case (Program j p "is" θ sb 𝒟 𝒪  p' is')
    then obtain
      ts': "ts' = ts[j:=(p',is@is',θ,sb,𝒟,𝒪,)]" and
      𝒮': "𝒮'=𝒮" and
      m': "m'=m" and
      j_bound: "j < length ts" and
      ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,)" and
      prog_step: "θ p p (p', is')"
      by auto

    from read_only_unowned [OF j_bound ts_j]
    show "read_only_unowned 𝒮' ts'"
      apply (simp only: ts' 𝒮')
      apply (rule read_only_unowned_nth_update [OF j_bound])
      apply force
      done
  next
    case (Memop j p "is" θ sb 𝒟 𝒪  is' θ' sb' 𝒟' 𝒪' ℛ')
    then obtain
      ts': "ts' = ts[j:=(p,is',θ',sb',𝒟',𝒪',ℛ')]" and
      j_bound: "j < length ts" and
      ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,)"  and
      mem_step: "(is, θ, sb, m, 𝒟, 𝒪, , 𝒮)  (is', θ', sb',m', 𝒟',  𝒪', ℛ', 𝒮')"
      by auto

    from safe_delayedE [OF safe j_bound ts_j]
    have safe_j: "map owned ts,map released ts,j(is, θ, m, 𝒟, 𝒪, 𝒮)".
    from mem_step
    show ?thesis
    proof (cases)
      case (Read volatile a t)
      then obtain
        "is": "is = Read volatile a t # is'" and
        θ': "θ' = θ(t  m a)" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from read_only_unowned [OF j_bound ts_j]
      show "read_only_unowned 𝒮' ts'"
        apply (simp only: ts' eqs')
        apply (rule read_only_unowned_nth_update [OF j_bound])
        apply force
        done

    next
      case (WriteNonVolatile a D f A L R W)
      then obtain
        "is": "is = Write False a (D, f) A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m(a:=f θ)" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      from read_only_unowned [OF j_bound ts_j]
      show "read_only_unowned 𝒮' ts'"
        apply (simp only: ts' eqs')
        apply (rule read_only_unowned_nth_update [OF j_bound])
        apply force
        done

    next
      case (WriteVolatile a D f A L R W)
      then obtain
        "is": "is = Write True a (D, f) A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m(a:=f θ)" and
        𝒟': "𝒟'=True" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮W RA L"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from safe_j [simplified "is"]
      obtain
        a_unowned_others: "k < length ts. jk  a  (map owned ts!k  dom (map released ts!k))" and
        A: "A  dom 𝒮  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length ts. jk   A   (map owned ts!k  dom (map released ts!k)) = {}" and
        a_not_ro: "a  read_only 𝒮"
        by cases auto

      show "read_only_unowned 𝒮' ts'"
      proof (unfold_locales)
        fix i pi "isi" 𝒪i i 𝒟i θi sbi
        assume i_bound: "i < length ts'"
        assume ts'_i: "ts'!i = (pi,isi,θi, sbi, 𝒟i, 𝒪i,i)"
        show "𝒪i  read_only 𝒮' = {}"
        proof (cases "i=j")
          case True
          with read_only_unowned [OF j_bound ts_j] ts'_i A L_A R_owns A_R j_bound 
          show ?thesis
            by (auto simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
        next
          case False
          from simple_ownership_distinct [OF j_bound _ False [symmetric] ts_j] ts'_i i_bound j_bound False
          have "𝒪  𝒪i = {}"
            by (fastforce simp add: ts')
          with A L_A R_owns A_R j_bound A_unowned_others [rule_format, of i] 
          read_only_unowned [of i pi isi θi sbi 𝒟i 𝒪i i]
            False i_bound ts'_i False
          show ?thesis
            by (force simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
        qed
      qed
    next      
      case Fence
      then obtain
        "is": "is = Fence # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      from read_only_unowned [OF j_bound ts_j]
      show "read_only_unowned 𝒮' ts'"
        apply (simp only: ts' eqs')
        apply (rule read_only_unowned_nth_update [OF j_bound])
        apply force
        done
    next
      case (RMWReadOnly cond t a D f ret A L R W)
      then obtain
        "is": "is = RMW a t (D, f) cond ret A L R W # is'" and
        θ': "θ' = θ(t m a)" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮" and
        cond: "¬ cond (θ(t  m a))"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      from read_only_unowned [OF j_bound ts_j]
      show "read_only_unowned 𝒮' ts'"
        apply (simp only: ts' eqs')
        apply (rule read_only_unowned_nth_update [OF j_bound])
        apply force
        done
    next
      case (RMWWrite cond t a D f ret A L R W)
      then obtain
        "is": "is = RMW a t (D, f) cond ret A L R W # is'" and
        θ': "θ' = θ(t  ret (m a) (f (θ(t  m a))))" and
        sb': "sb'=sb" and
        m': "m'=m(a := f (θ(t  m a)))" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮W RA L" and
        cond: "cond (θ(t  m a))"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      from safe_j [simplified "is"] cond
      obtain
        a_unowned_others: "k < length ts. jk  a  (map owned ts!k  dom (map released ts!k))" and
        A: "A  dom 𝒮  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length ts. jk   A   (map owned ts!k  dom (map released ts!k)) = {}" and
        a_not_ro: "a  read_only 𝒮"
        by cases auto

      show "read_only_unowned 𝒮' ts'"
      proof (unfold_locales)
        fix i pi "isi" 𝒪i i 𝒟i θi sbi
        assume i_bound: "i < length ts'"
        assume ts'_i: "ts'!i = (pi,isi,θi, sbi, 𝒟i, 𝒪i,i)"
        show "𝒪i  read_only 𝒮' = {}"
        proof (cases "i=j")
          case True
          with read_only_unowned [OF j_bound ts_j] ts'_i A L_A R_owns A_R j_bound 
          show ?thesis
            by (auto simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
        next
          case False
          from simple_ownership_distinct [OF j_bound _ False [symmetric] ts_j] ts'_i i_bound j_bound False
          have "𝒪  𝒪i = {}"
            by (fastforce simp add: ts')
          with A L_A R_owns A_R j_bound A_unowned_others [rule_format, of i] 
          read_only_unowned [of i pi isi θi sbi 𝒟i 𝒪i i]
            False i_bound ts'_i False
          show ?thesis
            by (force simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
        qed
      qed
    next
      case (Ghost A L R W) 
      then obtain
        "is": "is = Ghost A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=augment_rels (dom 𝒮) R " and
        𝒮': "𝒮'=𝒮W RA L"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from safe_j [simplified "is"]
      obtain
        A: "A  dom 𝒮  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length ts. jk   A   (map owned ts!k  dom (map released ts!k)) = {}" 
        by cases auto

      show "read_only_unowned 𝒮' ts'"
      proof (unfold_locales)
        fix i pi "isi" 𝒪i i 𝒟i θi sbi
        assume i_bound: "i < length ts'"
        assume ts'_i: "ts'!i = (pi,isi,θi, sbi, 𝒟i, 𝒪i,i)"
        show "𝒪i  read_only 𝒮' = {}"
        proof (cases "i=j")
          case True
          with read_only_unowned [OF j_bound ts_j] ts'_i A L_A R_owns A_R j_bound 
          show ?thesis
            by (auto simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
        next
          case False
          from simple_ownership_distinct [OF j_bound _ False [symmetric] ts_j] ts'_i i_bound j_bound False
          have "𝒪  𝒪i = {}"
            by (fastforce simp add: ts')
          with A L_A R_owns A_R j_bound A_unowned_others [rule_format, of i] 
          read_only_unowned [of i pi isi θi sbi 𝒟i 𝒪i i]
            False i_bound ts'_i False
          show ?thesis
            by (force simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
        qed
      qed
    qed
  next
    case (StoreBuffer _ p "is" θ sb 𝒟 𝒪  sb' 𝒪' ℛ')
    hence False 
      by (auto simp add: empty_storebuffer_step_def)
    thus ?thesis ..
  qed
qed


theorem (in program) safe_step_preserves_unowned_shared:
  assumes step: "(ts,m,𝒮) d (ts',m',𝒮')"
  assumes safe: "safe_delayed (ts,m,𝒮)"
  assumes dist: "simple_ownership_distinct ts"
  assumes unowned_shared: "unowned_shared 𝒮 ts"
  shows "unowned_shared 𝒮' ts'"
proof -
  interpret direct_computation:
    computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
  from dist interpret simple_ownership_distinct ts .
  from unowned_shared interpret unowned_shared 𝒮 ts .
  from step
  show ?thesis
  proof (cases)
    case (Program j p "is" θ sb 𝒟 𝒪  p' is')
    then obtain
      ts': "ts' = ts[j:=(p',is@is',θ,sb,𝒟,𝒪,)]" and
      𝒮': "𝒮'=𝒮" and
      m': "m'=m" and
      j_bound: "j < length ts" and
      ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,)" and
      prog_step: "θ p p (p', is')"
      by auto

    show "unowned_shared 𝒮' ts'"
      apply (simp only: ts' 𝒮')
      apply (rule unowned_shared_nth_update [OF j_bound ts_j] )
      apply force
      done
  next
    case (Memop j p "is" θ sb 𝒟 𝒪  is' θ' sb' 𝒟' 𝒪' ℛ')
    then obtain
      ts': "ts' = ts[j:=(p,is',θ',sb',𝒟',𝒪',ℛ')]" and
      j_bound: "j < length ts" and
      ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,)"  and
      mem_step: "(is, θ, sb, m, 𝒟, 𝒪, , 𝒮)  (is', θ', sb',m', 𝒟',  𝒪', ℛ', 𝒮')"
      by auto

    from safe_delayedE [OF safe j_bound ts_j]
    have safe_j: "map owned ts,map released ts,j(is, θ, m, 𝒟, 𝒪, 𝒮)".
    from mem_step
    show ?thesis
    proof (cases)
      case (Read volatile a t)
      then obtain
        "is": "is = Read volatile a t # is'" and
        θ': "θ' = θ(t  m a)" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      show "unowned_shared 𝒮' ts'"
        apply (simp only: ts' eqs')
        apply (rule unowned_shared_nth_update [OF j_bound ts_j])
        apply force
        done

    next
      case (WriteNonVolatile a D f A L R W)
      then obtain
        "is": "is = Write False a (D, f) A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m(a:=f θ)" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      
      show "unowned_shared 𝒮' ts'"
        apply (simp only: ts' eqs')
        apply (rule unowned_shared_nth_update [OF j_bound ts_j])
        apply force
        done

    next
      case (WriteVolatile a D f A L R W)
      then obtain
        "is": "is = Write True a (D, f) A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m(a:=f θ)" and
        𝒟': "𝒟'=True" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮W RA L"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from safe_j [simplified "is"]
      obtain
        a_unowned_others: "k < length ts. jk  a  (map owned ts!k  dom (map released ts!k))" and
        A: "A  dom 𝒮  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length ts. jk   A   (map owned ts!k  dom (map released ts!k)) = {}" and
        a_not_ro: "a  read_only 𝒮"
        by cases auto


      show "unowned_shared 𝒮' ts'"
      apply (clarsimp simp add: unowned_shared_def')
      using A R_owns L_A A_R A_unowned_others ts_j j_bound
      apply (auto simp add: 𝒮' ts' 𝒪')
      apply  (rule  unowned_shared')
      apply  clarsimp
      apply  (drule_tac x=i in spec)
      apply  (case_tac "i=j")
      apply   clarsimp
      apply  clarsimp
      apply (drule_tac x=j in spec)
      apply auto
      done
    next      
      case Fence
      then obtain
        "is": "is = Fence # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      
      show "unowned_shared 𝒮' ts'"
        apply (simp only: ts' eqs')
        apply (rule unowned_shared_nth_update [OF j_bound ts_j])
        apply force
        done
    next
      case (RMWReadOnly cond t a D f ret A L R W)
      then obtain
        "is": "is = RMW a t (D, f) cond ret A L R W # is'" and
        θ': "θ' = θ(t m a)" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮" and
        cond: "¬ cond (θ(t  m a))"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      show "unowned_shared 𝒮' ts'"
        apply (simp only: ts' eqs')
        apply (rule unowned_shared_nth_update [OF j_bound ts_j])
        apply force
        done
    next
      case (RMWWrite cond t a D f ret A L R W)
      then obtain
        "is": "is = RMW a t (D, f) cond ret A L R W # is'" and
        θ': "θ' = θ(t  ret (m a) (f (θ(t  m a))))" and
        sb': "sb'=sb" and
        m': "m'=m(a := f (θ(t  m a)))" and
        𝒟': "𝒟'=False" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=Map.empty" and
        𝒮': "𝒮'=𝒮W RA L" and
        cond: "cond (θ(t  m a))"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
      from safe_j [simplified "is"] cond
      obtain
        a_unowned_others: "k < length ts. jk  a  (map owned ts!k  dom (map released ts!k))" and
        A: "A  dom 𝒮  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length ts. jk   A   (map owned ts!k  dom (map released ts!k)) = {}" and
        a_not_ro: "a  read_only 𝒮"
        by cases auto

      show "unowned_shared 𝒮' ts'"
      apply (clarsimp simp add: unowned_shared_def')
      using A R_owns L_A A_R A_unowned_others ts_j j_bound
      apply (auto simp add: 𝒮' ts' 𝒪')
      apply  (rule  unowned_shared')
      apply  clarsimp
      apply  (drule_tac x=i in spec)
      apply  (case_tac "i=j")
      apply   clarsimp
      apply  clarsimp
      apply (drule_tac x=j in spec)
      apply auto
      done
    next
      case (Ghost A L R W) 
      then obtain
        "is": "is = Ghost A L R W # is'" and
        θ': "θ' = θ" and
        sb': "sb'=sb" and
        m': "m'=m" and
        𝒟': "𝒟'=𝒟" and
        𝒪': "𝒪'=𝒪  A - R" and
        ℛ': "ℛ'=augment_rels (dom 𝒮) R " and
        𝒮': "𝒮'=𝒮W RA L"
        by auto
      note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'

      from safe_j [simplified "is"]
      obtain
        A: "A  dom 𝒮  𝒪" and L_A: "L  A" and R_owns: "R  𝒪" and A_R: "A  R = {}" and
        A_unowned_others: "k < length ts. jk   A   (map owned ts!k  dom (map released ts!k)) = {}" 
        by cases auto
      show "unowned_shared 𝒮' ts'"
      apply (clarsimp simp add: unowned_shared_def')
      using A R_owns L_A A_R A_unowned_others ts_j j_bound
      apply (auto simp add: 𝒮' ts' 𝒪')
      apply  (rule  unowned_shared')
      apply  clarsimp
      apply  (drule_tac x=i in spec)
      apply  (case_tac "i=j")
      apply   clarsimp
      apply  clarsimp
      apply (drule_tac x=j in spec)
      apply auto
      done
    qed
  next
    case (StoreBuffer _ p "is" θ sb 𝒟 𝒪  sb' 𝒪' ℛ')
    hence False 
      by (auto simp add: empty_storebuffer_step_def)
    thus ?thesis ..
  qed
qed

locale program_trace = program +
fixes c       ― ‹enumeration of configurations: @{text "c n  ⇒d c (n + 1) ... ⇒d c (n + k)"} 
fixes n::nat  ― ‹starting index›
fixes k::nat  ― ‹steps›

assumes step: "l. l < k  c (n+l) d c (n + (Suc l))"

abbreviation (in program)
"trace  program_trace program_step"

lemma (in program) trace_0 [simp]: "trace c n 0"
apply (unfold_locales)
apply auto
done

lemma split_less_Suc: "(x<Suc k. P x) =  (P k  (x<k. P x))"
  apply rule
  apply  clarsimp
  apply clarsimp
  apply (case_tac "x = k") 
  apply auto
  done
  
lemma split_le_Suc: "(xSuc k. P x) =  (P (Suc k)  (xk. P x))"
  apply rule
  apply  clarsimp
  apply clarsimp
  apply (case_tac "x = Suc k") 
  apply auto
  done

lemma (in program) steps_to_trace: 
assumes steps: "x d* y"
shows "c k. trace c 0 k  c 0 = x  c k = y" 
using steps
proof (induct)
  case base
  thus ?case
    apply (rule_tac x="λk. x" in exI)
    apply (rule_tac x=0 in exI)
    by (auto simp add: program_trace_def)
next
  case (step y z)
  have first: "x d* y" by fact
  have last: "y d z" by fact
  from step.hyps obtain c k where
    trace: "trace c 0 k" and c_0: "c 0 = x" and c_k: "c k = y"
    by auto
  define c' where "c' == λi. (if i  k then c i else z)"
  from trace last c_k have "trace c' 0 (k + 1)"
    apply (clarsimp simp add: c'_def program_trace_def)
    apply (subgoal_tac "l=k")
    apply  (simp)
    apply (simp)
    done
  with c_0 
  show ?case
    apply -
    apply (rule_tac x="c'" in exI)
    apply (rule_tac x="k + 1" in exI)
    apply (auto simp add: c'_def)
    done
qed


lemma (in program) trace_preserves_length_ts: 
  "l x. trace c n k  l  k  x  k  length (fst (c (n + l))) = length (fst (c (n + x)))"
proof (induct k)
  case 0
  thus ?case by auto
next
  case (Suc k)
  then obtain trace_suc: "trace c n (Suc k)" and
    l_suc: "l  Suc k" and
    x_suc: "x  Suc k"
    by simp
  interpret direct_computation:
    computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .

  from trace_suc obtain
    trace_k: "trace c n k" and
    last_step: "c (n + k) d c (n + (Suc k)) "
    by (clarsimp simp add: program_trace_def)
  obtain ts 𝒮 m where c_k: "c (n + k) = (ts, m, 𝒮)" by (cases "c (n + k)") 
  obtain ts' 𝒮' m' where c_suc_k: "c (n + (Suc k)) = (ts', m', 𝒮')" by (cases "c (n + (Suc k))") 
  from direct_computation.step_preserves_length_ts [OF last_step [simplified c_k c_suc_k]] c_k c_suc_k
  have leq: "length (fst (c (n + Suc k))) = length (fst (c (n + k)))"
    by simp

  show ?case
  proof (cases "l = Suc k") 
    case True
    note l_suc = this
    show ?thesis
    proof (cases "x = Suc k") 
      case True with l_suc show ?thesis by simp
    next
      case False
      with x_suc have "x  k" by simp
      from Suc.hyps [OF trace_k this, of k]
      have "length (fst (c (n + x))) = length (fst (c (n + k)))"
        by simp
      with leq show ?thesis using l_suc by simp
    qed
  next
    case False
    with l_suc have l_k: "l  k"
      by auto
    show ?thesis
    proof (cases "x = Suc k") 
      case True
      from Suc.hyps [OF trace_k l_k, of k]
      have "length (fst (c (n + l))) = length (fst (c (n + k)))" by simp
      with leq True show ?thesis by simp
    next
      case False
      with x_suc have "x  k" by simp
      from Suc.hyps [OF trace_k l_k this]
      show ?thesis by simp
    qed
  qed
qed

lemma (in program) trace_preserves_simple_ownership_distinct: 
  assumes dist: "simple_ownership_distinct (fst (c n))"
  shows "l. trace c n k  (x < k. safe_delayed (c (n + x)))   
           l  k    simple_ownership_distinct (fst (c (n + l)))"
proof (induct k)
  case 0 thus ?case using dist by auto
next
  case (Suc k)
  then obtain 
    trace_suc: "trace c n (Suc k)" and
    safe_suc: "x<Suc k. safe_delayed (c (n + x))" and
    l_suc: "l  Suc k"
    by simp

  from trace_suc obtain
    trace_k: "trace c n k" and
    last_step: "c (n + k) d c (n + (Suc k)) "
    by (clarsimp simp add: program_trace_def)

  obtain ts 𝒮 m where c_k: "c (n + k) = (ts, m, 𝒮)" by (cases "c (n + k)") 
  obtain ts' 𝒮' m' where c_suc_k: "c (n + (Suc k)) = (ts', m', 𝒮')" by (cases "c (n + (Suc k))") 

  from safe_suc c_suc_k c_k
  obtain 
    safe_up_k: "x<k. safe_delayed (c (n + x))" and
    safe_k: "safe_delayed (ts,m,𝒮)" 
    by (auto simp add: split_le_Suc) 
  from Suc.hyps [OF trace_k safe_up_k] 
  have hyp: "l  k. simple_ownership_distinct (fst (c (n + l)))"
    by simp

  from Suc.hyps [OF trace_k safe_up_k, of k] c_k
  have "simple_ownership_distinct ts"
    by simp

  from safe_step_preserves_simple_ownership_distinct [OF last_step[simplified c_k c_suc_k] safe_k this]
  have "simple_ownership_distinct ts'".
  then show ?case
  using c_suc_k hyp l_suc
    apply (cases "l=Suc k")
    apply (auto simp add: split_less_Suc)
    done
qed

lemma (in program) trace_preserves_read_only_unowned: 
  assumes dist: "simple_ownership_distinct (fst (c n))"
  assumes ro: "read_only_unowned (snd (snd (c n))) (fst (c n))"
  shows "l. trace c n k  (x < k. safe_delayed (c (n + x)))   
           l  k    read_only_unowned (snd (snd (c (n + l)))) (fst (c (n + l)))"
proof (induct k)
  case 0 thus ?case using ro by auto
next
  case (Suc k)
  then obtain 
    trace_suc: "trace c n (Suc k)" and
    safe_suc: "x<Suc k. safe_delayed (c (n + x))" and
    l_suc: "l  Suc k"
    by simp

  from trace_suc obtain
    trace_k: "trace c n k" and
    last_step: "c (n + k) d c (n + (Suc k)) "
    by (clarsimp simp add: program_trace_def)

  obtain ts 𝒮 m where c_k: "c (n + k) = (ts, m, 𝒮)" by (cases "c (n + k)") 
  obtain ts' 𝒮' m' where c_suc_k: "c (n + (Suc k)) = (ts', m', 𝒮')" by (cases "c (n + (Suc k))") 

  from safe_suc c_suc_k c_k
  obtain 
    safe_up_k: "x<k. safe_delayed (c (n + x))" and
    safe_k: "safe_delayed (ts,m,𝒮)" 
    by (auto simp add: split_le_Suc) 
  from Suc.hyps [OF trace_k safe_up_k] 
  have hyp: "l  k. read_only_unowned (snd (snd (c (n + l)))) (fst (c (n + l)))"
    by simp

  from Suc.hyps [OF trace_k safe_up_k, of k] c_k
  have ro': "read_only_unowned 𝒮 ts"
    by simp

  from trace_preserves_simple_ownership_distinct [where c=c and n=n, OF dist trace_k safe_up_k, of k] c_k
  have dist': "simple_ownership_distinct ts" by simp

  from safe_step_preserves_read_only_unowned [OF last_step[simplified c_k c_suc_k] safe_k dist' ro']
  have "read_only_unowned 𝒮' ts'".
  then show ?case
  using c_suc_k hyp l_suc
    apply (cases "l=Suc k")
    apply (auto simp add: split_less_Suc)
    done
qed

lemma (in program) trace_preserves_unowned_shared: 
  assumes dist: "simple_ownership_distinct (fst (c n))"
  assumes ro: "unowned_shared (snd (snd (c n))) (fst (c n))"
  shows "l. trace c n k  (x < k. safe_delayed (c (n + x)))   
           l  k    unowned_shared (snd (snd (c (n + l)))) (fst (c (n + l)))"
proof (induct k)
  case 0 thus ?case using ro by auto
next
  case (Suc k)
  then obtain 
    trace_suc: "trace c n (Suc k)" and
    safe_suc: "x<Suc k. safe_delayed (c (n + x))" and
    l_suc: "l  Suc k"
    by simp

  from trace_suc obtain
    trace_k: "trace c n k" and
    last_step: "c (n + k) d c (n + (Suc k)) "
    by (clarsimp simp add: program_trace_def)

  obtain ts 𝒮 m where c_k: "c (n + k) = (ts, m, 𝒮)" by (cases "c (n + k)") 
  obtain ts' 𝒮' m' where c_suc_k: "c (n + (Suc k)) = (ts', m', 𝒮')" by (cases "c (n + (Suc k))") 

  from safe_suc c_suc_k c_k
  obtain 
    safe_up_k: "x<k. safe_delayed (c (n + x))" and
    safe_k: "safe_delayed (ts,m,𝒮)" 
    by (auto simp add: split_le_Suc) 
  from Suc.hyps [OF trace_k safe_up_k] 
  have hyp: "l  k. unowned_shared (snd (snd (c (n + l)))) (fst (c (n + l)))"
    by simp

  from Suc.hyps [OF trace_k safe_up_k, of k] c_k
  have ro': "unowned_shared 𝒮 ts"
    by simp

  from trace_preserves_simple_ownership_distinct [where c=c and n=n, OF dist trace_k safe_up_k, of k] c_k
  have dist': "simple_ownership_distinct ts" by simp

  from safe_step_preserves_unowned_shared [OF last_step[simplified c_k c_suc_k] safe_k dist' ro']
  have "unowned_shared 𝒮' ts'".
  then show ?case
  using c_suc_k hyp l_suc
    apply (cases "l=Suc k")
    apply (auto simp add: split_less_Suc)
    done
qed


theorem (in program_progress) undo_local_steps:
assumes steps: "trace c n k"
assumes c_n: "c n = (ts,m,𝒮)"
assumes unchanged: "l  k. (tsl 𝒮l ml . c (n + l) = (tsl,ml,𝒮l)  tsl!i=ts!i)"
assumes safe: "safe_delayed (u_ts, u_m, u_shared)"
assumes leq: "length u_ts = length ts"
assumes i_bound: "i < length ts"
assumes others_same: "j < length ts. ji  u_ts!j = ts!j"
assumes u_ts_i: "u_ts!i=(u_p,u_is,u_tmps,u_sb,u_dirty,u_owns,u_rels)"
assumes u_m_other: "a. a  u_owns  u_m a = m a"
assumes u_m_shared: "a. a  u_owns  a  dom u_shared  u_m a = m a"
assumes u_shared: "a. a  u_owns  a  owned (ts!i)  u_shared a = 𝒮 a"
assumes dist: "simple_ownership_distinct u_ts"
assumes dist_ts: "simple_ownership_distinct ts"
assumes safe_orig: "x.  x < k  safe_delayed (c (n + x))" 
shows "c' l. l  k  trace c' n l 

        c' n = (u_ts, u_m, u_shared) 
        (x  l. length (fst (c' (n + x))) = length (fst (c (n + x)))) 

        (x < l. safe_delayed (c' (n + x))) 
        (l < k  ¬ safe_delayed (c' (n + l)))  
       
        (x  l. tsx 𝒮x mx tsx' 𝒮x' mx' . c (n + x) = (tsx,mx,𝒮x)  c' (n+ x) = (tsx',mx',𝒮x')  
          tsx'!i=u_ts!i 
          (a  u_owns. 𝒮x' a = u_shared a) 
          (a  u_owns. 𝒮x a = 𝒮 a) 
          (a  u_owns. mx' a = u_m a) 
          (a  u_owns. mx a = m a)) 
        
        (x  l. tsx 𝒮x mx tsx' 𝒮x' mx'. c (n + x) = (tsx,mx,𝒮x)  c' (n + x) = (tsx',mx',𝒮x')  
         (j < length tsx. ji  tsx'!j = tsx!j) 
         (a. a  u_owns  a  owned (ts!i)  𝒮x' a = 𝒮x a) 
         (a. a  u_owns  mx' a = mx a))
"
using steps unchanged safe_orig
proof (induct k)
  case 0
  show ?case
    apply (rule_tac x="λ l. (u_ts, u_m, u_shared)" in exI)
    apply (rule_tac x=0 in exI)
    thm c_n
    apply (simp add: c_n)
    apply (clarsimp simp add: 0 leq others_same u_m_other u_shared)
    done
next
  case (Suc k)
  then obtain  
    trace_suc: "trace c n (Suc k)" and
    unchanged_suc: "lSuc k. tsl 𝒮l ml. c (n + l) = (tsl, ml, 𝒮l)  tsl ! i = ts ! i" and
    safe_orig: "x<k. safe_delayed (c (n + x))"
    by simp

  interpret direct_computation:
    computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
  from trace_suc obtain
    trace_k: "trace c n k" and
    last_step: "c (n + k) d c (n + (Suc k)) "
    by (clarsimp simp add: program_trace_def)

  from unchanged_suc obtain
    unchanged_k: "lk. tsl 𝒮l ml. c (n + l) = (tsl, ml, 𝒮l)  tsl ! i = ts ! i" and
    unchanged_suc_k: "tsl 𝒮l ml. c (n + (Suc k)) = (tsl, ml, 𝒮l)  tsl ! i = ts ! i"
    apply -
    apply (rule that)
    apply auto
    apply (drule_tac x=l in spec) (* Why the hack doesn't Isabelle try this *)
    apply simp
    done
  

  from Suc.hyps [OF trace_k unchanged_k safe_orig] obtain c' l where
    l_k: "l  k" and
    trace_c'_l: "trace c' n l" and
    safe_l: "(x<l. safe_delayed (c' (n + x)))" and
    unsafe_l: "(l < k  ¬ safe_delayed (c' (n + l)))" and
    c'_n: "c' n = (u_ts, u_m, u_shared)" and
    leq_l: "(xl. length (fst (c' (n + x))) = length (fst (c (n + x))))" and
    unchanged_i: "(xl. tsx 𝒮x mx tsx' 𝒮x' mx'.
                   c (n + x) = (tsx, mx, 𝒮x) 
                   c' (n + x) = (tsx', mx', 𝒮x') 
                   tsx' ! i = u_ts ! i 
                   (au_owns. 𝒮x' a = u_shared a) 
                   (au_owns. 𝒮x a = 𝒮 a) 
                   (au_owns. mx' a = u_m a) 
                   (au_owns. mx a = m a))" and
     sim: "(xl. tsx 𝒮x mx tsx' 𝒮x' mx'.
                   c (n + x) = (tsx, mx, 𝒮x) 
                   c' (n + x) = (tsx', mx', 𝒮x') 
                   (j<length tsx. j  i  tsx' ! j = tsx ! j) 
                   (a. a  u_owns  a  owned (ts!i)  𝒮x' a = 𝒮x a) 
                   (a. a  u_owns  mx' a = mx a))"
      by auto
    show ?case
    proof (cases "l < k")
      case True
      with True trace_c'_l safe_l unsafe_l unchanged_i sim leq_l c'_n
      show ?thesis
        apply -
        apply (rule_tac x="c'" in exI)
        apply (rule_tac x="l" in exI)
        apply auto
        done
    next
      case False
      with l_k have l_k: "l=k" by auto
      show ?thesis
      proof (cases "safe_delayed (c' (n + k))")
        case False
        with False l_k trace_c'_l safe_l unsafe_l unchanged_i sim leq_l c'_n
        show ?thesis
          apply -
          apply (rule_tac x="c'" in exI)
          apply (rule_tac x="k" in exI)
          apply auto
          done
      next
        case True
        note safe_k = this

        obtain tsk 𝒮k mk where c_k: "c (n + k) = (tsk,mk,𝒮k)"
          by (cases "c (n + k)")

        obtain tsk' 𝒮k' mk' where c_suc_k: "c (n + (Suc k)) = (tsk',mk',𝒮k')"
          by (cases "c (n + (Suc k))")

        obtain u_tsk u_sharedk u_mk where c'_k: "c' (n + k) = (u_tsk, u_mk, u_sharedk)"
          by (cases "c' (n + k)")

        from trace_preserves_length_ts [OF trace_k, of k 0] c_n c_k i_bound
        have i_bound_k: "i < length tsk"
          by simp

        from leq_l [rule_format, simplified l_k, of k] c_k c'_k
        have leq: "length u_tsk = length tsk"
          by simp
        
        note last_step = last_step [simplified c_k c_suc_k]
        from unchanged_suc_k c_suc_k
        have "tsk'!i = ts!i"
          by auto
        moreover from unchanged_k [rule_format, of k] c_k
        have unch_k_i: "tsk!i=ts!i"
          by auto
        ultimately have ts_eq: "tsk!i=tsk'!i"
          by simp

        from unchanged_i [simplified l_k, rule_format, OF _ c_k c'_k]
        obtain 
          u_ts_eq: "u_tsk ! i = u_ts ! i" and
          unchanged_shared: "au_owns. u_sharedk a = u_shared a"  and
          unchanged_shared_orig: "au_owns. 𝒮k a = 𝒮 a" and
          unchanged_owns: "au_owns. u_mk a = u_m a" and
          unchanged_owns_orig: "au_owns. mk a = m a"
          by fastforce

        from u_ts_eq u_ts_i
        have u_tsk_i: "u_tsk!i=(u_p,u_is,u_tmps,u_sb,u_dirty,u_owns,u_rels)"
          by auto
        from sim [simplified l_k, rule_format, of k, OF _ c_k c'_k]  
        obtain
          ts_sim: "(j<length tsk. j  i  u_tsk ! j = tsk ! j)" and
          shared_sim: "(a. a  u_owns  a  owned (tsk!i)  u_sharedk a = 𝒮k a)" and
          mem_sim: "(a. a  u_owns  u_mk a = mk a)"
          by (auto simp add: unch_k_i)

        

        from unchanged_owns_orig unchanged_owns u_m_shared unchanged_shared
        have unchanged_owns_shared: "a. a  u_owns  a  dom u_sharedk  u_mk a = mk a"
          by (auto simp add: simp add: domIff)

        from safe_l l_k safe_k
        have safe_up_k: "x<k. safe_delayed (c' (n + x))"
          apply clarsimp
          done
        from trace_preserves_simple_ownership_distinct [OF _ trace_c'_l [simplified l_k] safe_up_k, 
          simplified c'_n, simplified, OF dist, of k] c'_k
        have dist': "simple_ownership_distinct u_tsk"
          by simp
        

        from trace_preserves_simple_ownership_distinct [OF _ trace_k, simplified c_n, simplified, OF dist_ts safe_orig, of k] 
        c_k
        have dist_orig': "simple_ownership_distinct tsk"
          by simp

        from undo_local_step [OF last_step i_bound_k ts_eq safe_k [simplified c'_k] leq ts_sim u_tsk_i mem_sim 
          unchanged_owns_shared shared_sim dist' dist_orig']
        obtain u_ts' u_shared' u_m' where
           step': "(u_tsk, u_mk, u_sharedk) d (u_ts', u_m', u_shared')" and
           ts_eq': "u_ts' ! i = u_tsk ! i" and
           unchanged_shared': "(au_owns. u_shared' a = u_sharedk a)" and
           unchanged_shared_orig': "(au_owns. 𝒮k' a = 𝒮k a)" and
           unchanged_owns': "(au_owns. u_m' a = u_mk a)" and
           unchanged_owns_orig': "(au_owns. mk' a = mk a)" and
           sim_ts': "(j<length tsk. j  i  u_ts' ! j = tsk' ! j)" and
           sim_shared': "(a. a  u_owns  a  owned (tsk ! i)  u_shared' a = 𝒮k' a)" and
           sim_m': "(a. a  u_owns  u_m' a = mk' a)"
          by auto

        define c'' where "c'' == λl. if l  n + k then c' l else (u_ts', u_m', u_shared')"
        have [simp]: "x  n + k. c'' x = c' x"
          by (auto simp add: c''_def)
        have [simp]: "c'' (Suc (n + k)) = (u_ts', u_m', u_shared')"
          by (auto simp add: c''_def)

        from trace_c'_l l_k step' c'_k  have trace': "trace c'' n (Suc k)"
         apply (simp add: program_trace_def)
         apply (clarsimp simp add: split_less_Suc)
         done

        from direct_computation.step_preserves_length_ts [OF last_step]
        have leq_tsk': "length tsk' = length tsk".

        with direct_computation.step_preserves_length_ts [OF step'] leq
        have leq': "length u_ts' = length tsk"
          by simp
        show ?thesis
          apply (rule_tac x=c'' in exI)
          apply (rule_tac x="Suc k" in exI)
          using safe_l l_k unchanged_i sim c_suc_k leq_l c'_n leq'
          apply (clarsimp simp add: split_less_Suc split_le_Suc safe_k trace' leq_tsk' sim_ts' sim_shared' sim_m' unch_k_i
            
            ts_eq' u_ts_eq
            unchanged_shared' unchanged_shared unchanged_shared_orig unchanged_shared_orig'
            unchanged_owns' unchanged_owns
            unchanged_owns_orig' unchanged_owns_orig )
          done
    qed (* FIXME: indentation *)
  qed         
qed


locale program_safe_reach_upto = program +
  fixes n fixes safe fixes c0
  assumes safe_config: "k  n; trace c 0 k; c 0 = c0; l  k   safe (c l)"

abbreviation (in program)
  "safe_reach_upto  program_safe_reach_upto program_step"

lemma (in program) safe_reach_upto_le:
  assumes safe: "safe_reach_upto n safe c0"
  assumes m_n: "m  n"
  shows "safe_reach_upto m safe c0"
using safe m_n
apply (clarsimp simp add: program_safe_reach_upto_def)
  subgoal for k c
    apply (subgoal_tac "k  n")
     apply blast
    apply simp
  done
done


lemma (in program) last_action_of_thread:
assumes trace: "trace c 0 k"
shows 
  "― ‹thread i never executes›  
  (l  k. fst (c l)!i = fst (c k)!i)  
  ― ‹thread i has a last step in the trace›
  (last <  k.  
    fst (c last)!i  fst (c (Suc last))!i 
    (l. last < l  l  k  fst (c l)!i = fst (c k)!i)) "
using trace
proof (induct k)    
  case 0 thus ?case
    by auto
next
  case (Suc k)
  hence "trace c 0 (Suc k)" by simp
  then
  obtain
    trace_k: "trace c 0 k" and
    last_step: "c k d c (Suc k) "
    by (clarsimp simp add: program_trace_def)  
  
  show ?case
  proof (cases "fst (c k)!i = fst (c (Suc k))!i")
    case False
    then show ?thesis
      apply -
      apply (rule disjI2)
      apply (rule_tac x=k in exI)
      apply clarsimp
      apply (subgoal_tac "l=Suc k")
      apply auto
      done
  next
    case True
    note idle_i = this


    {
      assume same: "(lk. fst (c l) ! i = fst (c k) ! i)"
      have ?thesis
        apply -
        apply (rule disjI1)
        apply clarsimp
        apply (case_tac "l=Suc k")
        apply  (simp add: idle_i)
        apply (rule same [simplified idle_i, rule_format])
        apply simp
        done
    }
    moreover
    {
      fix last
      assume last_k: "last < k"
      assume last_step: "fst (c last) ! i  fst (c (Suc last)) ! i"
      assume idle: "(l>last. l  k  fst (c l) ! i = fst (c k) ! i)"
      have ?thesis
        apply -
        apply (rule disjI2)
        apply (rule_tac x=last in exI)
        using last_k 
        apply (simp add:  last_step)
        using idle [simplified idle_i] 
        apply clarsimp
        apply (case_tac "l=Suc k")
        apply  clarsimp
        apply clarsimp
        done
    }
    moreover note Suc.hyps [OF trace_k]
    ultimately
    show ?thesis
      by blast
  qed
qed

lemma (in program) sequence_traces:
assumes trace1: "trace c1 0 k"
assumes trace2: "trace c2 m l"
assumes seq: "c2 m = c1 k"
assumes c_def: "c = (λx. if x   k then c1 x else (c2 (m + x -k)))"
shows "trace c 0 (k + l)"
proof -
  from trace1
  interpret trace1: program_trace program_step c1 0 k .
  from trace2
  interpret trace2: program_trace program_step c2 m l .
  {
    fix x
    assume x_bound: "x < (k + l)" 
    have "c x d c (Suc x)"
    proof (cases "x < k")
      case True
      from trace1.step [OF True] True
      show ?thesis
        by (simp add: c_def)
    next
      case False
      hence k_x: "k  x"
        by auto
      with x_bound have bound: "x - k < l"
        by auto
      from k_x have eq: "(Suc (m + x) - k) = Suc (m + x - k)"
        by simp
      from trace2.step [OF bound] k_x seq
      show ?thesis
        by (auto simp add: c_def eq)
    qed
  }
  thus ?thesis
    by (auto simp add: program_trace_def)
qed
      
theorem (in program_progress) safe_free_flowing_implies_safe_delayed:
  assumes init: "initial c0"
  assumes dist: "simple_ownership_distinct (fst c0)"
  assumes read_only_unowned: "read_only_unowned (snd (snd c0)) (fst c0)"
  assumes unowned_shared: "unowned_shared (snd (snd c0)) (fst c0)"
  assumes safe_reach_ff: "safe_reach_upto n safe_free_flowing c0"
  shows "safe_reach_upto n safe_delayed c0"
using safe_reach_ff 
proof (induct n)
  case 0
  hence "safe_reach_upto 0 safe_free_flowing c0" by simp
  hence "safe_free_flowing c0"
    by (auto simp add: program_safe_reach_upto_def)
  from initial_safe_free_flowing_implies_safe_delayed [OF init this]
  have "safe_delayed c0".
  then show ?case
    by (simp add: program_safe_reach_upto_def)
next
  case (Suc n)
  hence safe_reach_suc: "safe_reach_upto (Suc n) safe_free_flowing c0" by simp
  then interpret safe_reach_suc_inter: program_safe_reach_upto program_step "(Suc n)" safe_free_flowing c0 .
  from safe_reach_upto_le [OF safe_reach_suc ]  
  have safe_reach_n: "safe_reach_upto n safe_free_flowing c0" by simp
  from Suc.hyps [OF this]
  have safe_delayed_reach_n: "safe_reach_upto n safe_delayed c0".
  then interpret safe_delayed_reach_inter: program_safe_reach_upto program_step "n" safe_delayed c0 .
  interpret direct_computation:
    computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
  show ?case
  proof (cases "safe_reach_upto (Suc n) safe_delayed c0")
    case True thus ?thesis .
  next
    case False
    from safe_delayed_reach_n False
    obtain c where
      trace: "trace c 0 (Suc n)" and
      c_0: "c 0 = c0" and
      safe_delayed_upto_n: "kn. safe_delayed (c k)" and
      violation_delayed_suc: "¬ safe_delayed (c (Suc n))"
    proof -
      from False
      obtain c k l where 
        k_suc: "k  Suc n" and
        trace_k: "trace c 0 k" and 
        l_k: "l  k" and
        violation: "¬ safe_delayed (c l)" and
        start: "c 0 = c0"
        by (clarsimp simp add: program_safe_reach_upto_def)
    
      show ?thesis
      proof (cases "k = Suc n")
        case False
        with k_suc have "k  n"
          by auto
        from safe_delayed_reach_inter.safe_config [where c=c, OF this trace_k start l_k]
        have "safe_delayed (c l)".
        with violation have False by simp
        thus ?thesis ..
      next
        case True
        note k_suc_n = this
        from trace_k True have trace_n: "trace c 0 n"
          by (auto simp add: program_trace_def)
        show ?thesis
        proof (cases "l=Suc n") 
          case False
          with k_suc_n l_k have "l  n" by simp
          from safe_delayed_reach_inter.safe_config [where c=c, OF _ trace_n start this ]
          have "safe_delayed (c l)" by simp
          with violation have False by simp
          thus ?thesis ..
        next
          case True
          from safe_delayed_reach_inter.safe_config [where c=c, OF _ trace_n start]
          have "kn. safe_delayed (c k)" by simp
          with True k_suc_n trace_k start violation
          show ?thesis
            apply -
            apply (rule that)
            apply auto
            done
        qed    
      qed
    qed

    from trace
    interpret trace_inter: program_trace program_step c 0 "Suc n" .

    from safe_reach_suc_inter.safe_config [where c=c, OF _ trace c_0]
    have safe_suc: "safe_free_flowing (c (Suc n))"
      by auto
    
    obtain ts 𝒮 m where c_suc: "c (Suc n) = (ts,m,𝒮)" by (cases "c (Suc n)")
    from violation_delayed_suc c_suc
    obtain i p "is" θ sb 𝒟 𝒪  where
      i_bound: "i < length ts" and
      ts_i: "ts ! i = (p,is,θ,sb,𝒟,𝒪,)" and
      violation_i: "¬ map owned ts,map released ts,i (is,θ,m,𝒟,𝒪,𝒮) "
      by (fastforce simp add: safe_free_flowing_def safe_delayed_def)

    from trace_preserves_unowned_shared [where c=c and n=0 and l="Suc n", 
          simplified c_0, OF dist unowned_shared trace] safe_delayed_upto_n  c_suc
    have "unowned_shared 𝒮 ts" by auto
    then interpret unowned_shared 𝒮 ts .

    
    from violation_i obtain ins is' where "is": "is = ins#is'"
      by (cases "is") (auto simp add: safe_delayed_direct_memop_state.Nil)
    from safeE [OF safe_suc [simplified c_suc] i_bound ts_i]
    have safe_i: "map owned ts,i(is, θ, m, 𝒟, 𝒪, 𝒮)".

    define races where "races == λ. (case ins of
         Read volatile a t  ( a = Some False)  (¬ volatile  a  dom )
       | Write volatile a sop A L R W  (a  dom   (volatile  A  dom   {}))
       | Ghost A L R W  (A  dom   {})
       | RMW a t (D,f) cond ret A L R W  (if cond (θ(t  m a)) 
                                           then a  dom   A  dom   {}
                                           else  a = Some False)
       | _  False)"



    {
      assume no_race: 
        " j. j < length ts  ji  ¬ races (released (ts!j))"
      from safe_i 
      have "map owned ts,map released ts,i (is,θ,m,𝒟,𝒪,𝒮) "
      proof cases
        case Read
        thus ?thesis
          using "is" no_race
          by (auto simp add: races_def intro: safe_delayed_direct_memop_state.intros)
      next
        case WriteNonVolatile
        thus ?thesis
          using "is" no_race
          by (auto simp add: races_def intro: safe_delayed_direct_memop_state.intros)
      next
        case WriteVolatile
        thus ?thesis
          using "is" no_race
          apply (clarsimp simp add: races_def) 
          apply (rule safe_delayed_direct_memop_state.intros)
          apply auto
          done
      next
        case Fence
        thus ?thesis
          using "is" no_race
          by (auto simp add: races_def intro: safe_delayed_direct_memop_state.intros)
      next
        case Ghost
        thus ?thesis
          using "is" no_race
          apply (clarsimp simp add: races_def) 
          apply (rule safe_delayed_direct_memop_state.intros)
          apply auto
          done
      next
        case RMWReadOnly
        thus ?thesis
          using "is" no_race
          by (auto simp add: races_def intro: safe_delayed_direct_memop_state.intros)
      next
        case (RMWWrite cond t a _ _ A _ 𝒪)
        thus ?thesis
          using "is" no_race unowned_shared' [rule_format, of a] ts_i
          apply (clarsimp simp add: races_def) 
          apply (rule safe_delayed_direct_memop_state.RMWWrite)
          apply auto
          apply force
          done
      next
        case Nil with "is" show ?thesis by auto
      qed
    }
    with violation_i
    obtain j where
      j_bound: "j < length ts" and
      neq_j_i: "j  i" and
      race: "races (released (ts!j))"
      by auto
    
    obtain pj "isj" θj sbj 𝒟j 𝒪j j where
      ts_j: "ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
      apply (cases "ts!j")
      apply force
      done

    from race 
    havej_non_empty: "j  Map.empty"
      by (auto simp add: ts_j races_def split: instr.splits if_split_asm)

    {
      assume idle_j: "lSuc n. fst (c l) ! j = fst (c (Suc n)) ! j"
      have ?thesis
      proof -
        from idle_j [rule_format, of 0] c_suc  c_0 ts_j
        have c0_j: "fst c0 ! j = ts!j"
          by clarsimp
        from trace_preserves_length_ts [OF trace, of 0 "Suc n"] c_0 c_suc
        have "length (fst c0) = length ts"
          by clarsimp
        with j_bound have "j < length (fst c0)"
          by simp
        with nth_mem [OF this] init c0_j ts_j 
        have "j = Map.empty"
          by (auto simp add: initial_def)
        withj_non_empty have False
          by simp
        thus ?thesis ..
      qed
    }
    moreover
    {
      fix last
      assume last_bound: "last<Suc n" 
      assume last_step_changed_j: "fst (c last) ! j  fst (c (Suc last)) ! j"
      assume idle_rest: "l>last. l  Suc n  fst (c l) ! j = fst (c (Suc n)) ! j"
      have ?thesis
      proof -
        obtain tsl 𝒮l ml where
           c_last: "c last = (tsl,ml,𝒮l)"
          by (cases "c last")
        obtain tsl' 𝒮l' ml' where
           c_last': "c (Suc last) = (tsl',ml',𝒮l')"
          by (cases "c (Suc last)")
        from idle_rest [rule_format, of "Suc last" ] c_suc c_last' last_bound
        have tsl'_j: "tsl'!j = ts!j"
          by auto

        from last_step_changed_j c_last c_last'
        have j_changed: "tsl!j  tsl'!j"
           by auto

        from trace_inter.step [OF last_bound] c_last c_last'
        have last_step: "(tsl,ml,𝒮l) d (tsl',ml',𝒮l')"
          by simp

        obtain pl "isl" θl sbl 𝒟l 𝒪l l where
          tsl_j: "tsl!j = (pl,isl,θl,sbl,𝒟l,𝒪l,l)"
          apply (cases "tsl!j")
          apply force
          done
(*
        obtain pl' "isl'" θl' sbl' 𝒟l' 𝒪l' ℛl' where
          tsl'_j: "tsl'!j = (pl',isl',θl',sbl',𝒟l',𝒪l',ℛl')"
          apply (cases "tsl'!j")
          apply force
          done
*)      
        from trace_preserves_length_ts [OF trace, of last "Suc n"] c_last c_suc last_bound
        have leql: "length tsl = length ts"
          by simp
        with j_bound have j_boundl: "j < length tsl"
          by simp

        from trace have trace_n: "trace c 0 n"
          by (auto simp add: program_trace_def)
        
        from safe_delayed_reach_inter.safe_config [where k=n and c=c and l=last, OF _ trace_n c_0] last_bound c_last
        have safe_delayed_last: "safe_delayed (tsl,ml,𝒮l)"
          by auto
        
        from safe_delayed_reach_inter.safe_config [where c=c, OF _ trace_n c_0] 
        have safe_delayed_upto_n: "x<n. safe_delayed (c (0 + x))"
          by auto
        from trace_preserves_simple_ownership_distinct [where c=c and n=0 and l=last, 
          simplified c_0, OF dist trace_n safe_delayed_upto_n]
          last_bound c_last
        have dist_last: "simple_ownership_distinct tsl" 
          by auto

        from trace_preserves_read_only_unowned [where c=c and n=0 and l=last, 
          simplified c_0, OF dist read_only_unowned trace_n safe_delayed_upto_n]
          last_bound c_last
        have ro_last_last: "read_only_unowned 𝒮l tsl" 
          by auto


        
        from safe_delayed_reach_inter.safe_config [where c=c, OF _ trace_n c_0] 
        have safe_delayed_upto_suc_n: "x<Suc n. safe_delayed (c (0 + x))"
          by auto

        from trace_preserves_simple_ownership_distinct [where c=c and n=0 and l="Suc last", 
          simplified c_0, OF dist trace safe_delayed_upto_suc_n]
          last_bound c_last'
        have dist_last': "simple_ownership_distinct tsl'" 
          by auto
        from trace last_bound have trace_last: "trace c 0 last"
          by (auto simp add: program_trace_def)

        from trace last_bound have trace_rest: "trace c (Suc last) (n - last)"
          by (auto simp add: program_trace_def)

        from idle_rest last_bound
        have idle_rest':
            "ln - last.
                      tsl 𝒮l ml. c (Suc last + l) = (tsl, ml, 𝒮l)  tsl ! j = tsl' ! j"
          apply clarsimp
          apply (drule_tac x="Suc (last + l)" in spec)
          apply (auto simp add: c_last' c_suc tsl'_j)
          done

        from safe_delayed_upto_suc_n [rule_format, of last] last_bound 
        have safe_delayed_last: "safe_delayed (tsl, ml, 𝒮l)"
          by (auto simp add: c_last)
        from safe_delayedE [OF this j_boundl tsl_j] 
        have safel: "map owned tsl,map released tsl,j(isl, θl, ml, 𝒟l, 𝒪l, 𝒮l)".
        
        from safe_delayed_reach_inter.safe_config [where c=c, OF _ trace_n c_0] 
        have safe_delayed_upto_last: "x<n - last. safe_delayed (c (Suc (last + x)))"
          by auto

        from last_step
        show ?thesis
        proof (cases)
          case (Program i' _ _ _ _ _ _ _ p' is')
          with j_changed j_boundl tsl_j 
          obtain
            tsl': "tsl' = tsl[j:=(p',isl@is',θl,sbl,𝒟l,𝒪l,l)]" and
            𝒮l': "𝒮l'=𝒮l" and
            ml': "ml'=ml" and
            prog_step: "θl pl p (p', is')"
            by (cases "i'=j") auto
          from tsl'_j tsl' ts_j j_boundl
          obtain eqs: "p'=pj" "isl@is'=isj" "θl=θj" "𝒟l=𝒟j" "𝒪l=𝒪j" "l=j"
            by auto


          from undo_local_steps [where c=c, OF trace_rest c_last' idle_rest' safe_delayed_last, simplified tsl', 
            simplified,
            OF j_boundl tsl_j [simplified], simplified ml' 𝒮l', simplified, OF dist_last  
            dist_last' [simplified tsl',simplified] safe_delayed_upto_last]
          obtain c' k where
            k_bound: "k  n - last" and
            trace_c': "trace c' (Suc last) k" and
            c'_first: "c' (Suc last) = (tsl, ml, 𝒮l)" and
            c'_leq: "(xk. length (fst (c' (Suc (last + x)))) = length (fst (c (Suc (last + x)))))" and
            c'_safe: "(x<k. safe_delayed (c' (Suc (last + x))))" and
            c'_unsafe: "(k < n - last  ¬ safe_delayed (c' (Suc (last + k))))" and
            c'_unch: 
               "(xk. tsx 𝒮x mx.
                   c (Suc (last + x)) = (tsx, mx, 𝒮x) 
                   (tsx' 𝒮x' mx'.
                       c' (Suc (last + x)) = (tsx', mx', 𝒮x') 
                       tsx' ! j = tsl ! j 
                       (a𝒪l. 𝒮x' a = 𝒮l a) 
                       (a𝒪l. 𝒮x a = 𝒮l a) 
                       (a𝒪l. mx' a = ml a)  (a𝒪l. mx a = ml a)))" and
            c'_sim:
               "(xk. tsx 𝒮x mx.
                   c (Suc (last + x)) = (tsx, mx, 𝒮x) 
                   (tsx' 𝒮x' mx'.
                       c' (Suc (last + x)) = (tsx', mx', 𝒮x') 
                       (ja<length tsx. ja  j  tsx' ! ja = tsx ! ja) 
                       (a. a  𝒪l  𝒮x' a = 𝒮x a) 
                       (a. a  𝒪l  mx' a = mx a)))"
            by auto

          obtain c_undo where c_undo:  "c_undo = (λx. if x  last then c x else c' (Suc last + x - last))"
            by blast
          have c_undo_0: "c_undo 0 = c0"
            by (auto simp add: c_undo c_0)
          from sequence_traces [OF trace_last trace_c', simplified c_last, OF c'_first c_undo]
          have trace_undo: "trace c_undo 0 (last + k)" .
          obtain u_ts u_shared u_m where 
            c_undo_n: "c_undo n = (u_ts,u_m, u_shared)"
            by (cases "c_undo n") 
          with last_bound c'_first c_last
          have c'_suc: "c' (Suc n) = (u_ts,u_m, u_shared)"
            apply (auto simp add: c_undo split: if_split_asm)
            apply (subgoal_tac "n=last")
            apply auto
            done

          
          show ?thesis  
          proof (cases "k < n - last")
            case True
            with c'_unsafe have unsafe: "¬ safe_delayed (c_undo (last + k))"
              by (auto simp add: c_undo c_last c'_first)
            from True have "last + k  n"
              by auto
            from safe_delayed_reach_inter.safe_config [OF this trace_undo, of "last + k"]
            have "safe_delayed (c_undo (last + k))"
              by (auto simp add: c_undo c_0)
            with unsafe have False by simp
            thus ?thesis ..
          next
            case False
            with k_bound have k: "k = n - last"
              by auto
            have eq': "Suc (last + (n - last)) = Suc n"
              using last_bound
              by simp
            from c'_unch [rule_format, of k, simplified k eq', OF _ c_suc c'_suc]
            obtain u_ts_j: "u_ts!j = tsl!j" and
              shared_unch: "a𝒪l. u_shared a = 𝒮l a" and
              shared_orig_unch: "a𝒪l. 𝒮 a = 𝒮l a" and
              mem_unch: "a𝒪l. u_m a = ml a" and 
              mem_unch_orig: "a𝒪l. m a = ml a"
              by auto

            from c'_sim [rule_format, of k, simplified k eq', OF _ c_suc c'_suc] i_bound neq_j_i
            obtain u_ts_i: "u_ts!i = ts!i" and
               shared_sim: "a. a  𝒪l  u_shared a = 𝒮 a" and
               mem_sim: "a. a  𝒪l  u_m a = m a"
              by auto
          
            from c'_leq [rule_format, of k] c'_suc c_suc
            have leq_u_ts: "length u_ts = length ts"
              by (auto simp add: eq' k)

            from j_bound leq_u_ts
            have j_bound_u: "j < length u_ts"
              by simp
            from i_bound leq_u_ts
            have i_bound_u: "i < length u_ts"
              by simp
            from k last_bound have l_k_eq: "last + k = n"
              by auto
            from safe_delayed_reach_inter.safe_config [OF _ trace_undo, simplified l_k_eq] 
              k c_0 last_bound
            have safe_delayed_c_undo': "x n. safe_delayed (c_undo x)"
              by (auto simp add: c_undo split: if_split_asm)
            hence safe_delayed_c_undo: "x<n. safe_delayed (c_undo x)"
              by (auto)
            from trace_preserves_simple_ownership_distinct [OF _ trace_undo, 
              simplified l_k_eq c_undo_0, simplified, OF dist this, of n] dist c_undo_n
            have dist_u_ts: "simple_ownership_distinct u_ts"
              by auto
            then interpret dist_u_ts_inter: simple_ownership_distinct u_ts .
          
            {
              fix a
              have "u_m a = m a"
              proof (cases "a  𝒪l") 
                case True with mem_unch
                have "u_m a = ml a"
                  by auto
                moreover
                from True mem_unch_orig
                have "m a = ml a" 
                  by auto
                ultimately show ?thesis by simp
              next
                case False
                with mem_sim
                show ?thesis
                  by auto
              qed
            } hence u_m_eq: "u_m = m" by - (rule ext, auto) 

            {
              fix a
              have "u_shared a = 𝒮 a"
              proof (cases "a  𝒪l") 
                case True with shared_unch
                have "u_shared a = 𝒮l a"
                  by auto
                moreover
                from True shared_orig_unch
                have "𝒮 a = 𝒮l a" 
                  by auto
                ultimately show ?thesis by simp
              next
                case False
                with shared_sim
                show ?thesis
                  by auto
              qed
            } hence u_shared_eq: "u_shared = 𝒮" by - (rule ext, auto) 

            {
              assume safe: "map owned u_ts,map released u_ts,i (is,θ,u_m,𝒟,𝒪,u_shared) "
              then have False
              proof cases
                case Read
                then show ?thesis
                using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                  by (auto simp add:eqs races_def split: if_split_asm)
              next
                case WriteNonVolatile
                then show ?thesis
                using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                  by (auto simp add:eqs races_def split: if_split_asm)
              next
                case WriteVolatile
                then show ?thesis
                using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                  apply (auto simp add:eqs races_def split: if_split_asm)
                  apply fastforce
                  done
              next
                case Fence
                then show ?thesis
                using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                  by (auto simp add:eqs races_def split: if_split_asm)
              next
                case Ghost
                then show ?thesis
                using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                  apply (auto simp add:eqs races_def split: if_split_asm)
                  apply fastforce
                  done
              next
                case (RMWReadOnly cond t a D f ret A L R W)
                then show ?thesis
                using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                  by (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
              next
                case RMWWrite
                then show ?thesis
                using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                  apply (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
                  apply fastforce+
                  done
              next
                case Nil
                then show ?thesis
                using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                  by (auto simp add:eqs races_def split: if_split_asm)
              qed
            }
            hence "¬ safe_delayed (u_ts, u_m, u_shared)"
              apply (clarsimp simp add: safe_delayed_def)
              apply (rule_tac x=i in exI)
              using u_ts_i ts_i i_bound_u
              apply auto
              done
            moreover
            from safe_delayed_c_undo' [rule_format, of n] c_undo_n
            have "safe_delayed (u_ts, u_m, u_shared)"
              by simp
            ultimately have False
              by simp
            thus ?thesis 
              by simp
          qed
        next
          case (Memop i' _ _ _ _ _ _ _ "isl'" θl' sbl' 𝒟l' 𝒪l' l')
          with j_changed j_boundl tsl_j 
          obtain             
            tsl': "tsl' = tsl[j:=(pl,isl',θl',sbl',𝒟l',𝒪l',l')]" and
            mem_step: "(isl, θl, sbl, ml, 𝒟l, 𝒪l, l,𝒮l)  
              (isl', θl', sbl', ml', 𝒟l', 𝒪l', l', 𝒮l')"
              by (cases "i'=j") auto

          from mem_step  
          show ?thesis
          proof (cases)
            case (Read volatile a t)
            then obtain
              "isl": "isl = Read volatile a t # isl'" and
              θl': "θl' = θl(t  ml a)"  and
              sbl': "sbl'=sbl" and
              𝒟l': "𝒟l'=𝒟l" and
              𝒪l': "𝒪l' = 𝒪l" andl': "l'= l" and
              𝒮l': "𝒮l'=𝒮l" and
              ml': "ml' = ml"
              by auto
            note eqs' = θl' sbl' 𝒟l' 𝒪l' ℛl' 𝒮l' ml'
            from tsl'_j tsl' ts_j j_boundl eqs'
            obtain eqs: "pl=pj" "isl'=isj" "θl(t  ml a)=θj" "𝒟l=𝒟j" "𝒪l=𝒪j" "l=j"
              by auto

            (* FIXME: now the same proof as for Program step *)
            from undo_local_steps [where c=c, OF trace_rest c_last' idle_rest' safe_delayed_last, simplified tsl', 
            simplified,
            OF j_boundl tsl_j [simplified], simplified ml' 𝒮l', simplified, OF dist_last 
              dist_last' [simplified tsl',simplified] safe_delayed_upto_last]
            obtain c' k where
              k_bound: "k  n - last" and
              trace_c': "trace c' (Suc last) k" and
              c'_first: "c' (Suc last) = (tsl, ml, 𝒮l)" and
              c'_leq: "(xk. length (fst (c' (Suc (last + x)))) = length (fst (c (Suc (last + x)))))" and
              c'_safe: "(x<k. safe_delayed (c' (Suc (last + x))))" and
              c'_unsafe: "(k < n - last  ¬ safe_delayed (c' (Suc (last + k))))" and
              c'_unch: 
               "(xk. tsx 𝒮x mx.
                   c (Suc (last + x)) = (tsx, mx, 𝒮x) 
                   (tsx' 𝒮x' mx'.
                       c' (Suc (last + x)) = (tsx', mx', 𝒮x') 
                       tsx' ! j = tsl ! j 
                       (a𝒪l. 𝒮x' a = 𝒮l a) 
                       (a𝒪l. 𝒮x a = 𝒮l a) 
                       (a𝒪l. mx' a = ml a)  (a𝒪l. mx a = ml a)))" and
              c'_sim:
               "(xk. tsx 𝒮x mx.
                   c (Suc (last + x)) = (tsx, mx, 𝒮x) 
                   (tsx' 𝒮x' mx'.
                       c' (Suc (last + x)) = (tsx', mx', 𝒮x') 
                       (ja<length tsx. ja  j  tsx' ! ja = tsx ! ja) 
                       (a. a  𝒪l  𝒮x' a = 𝒮x a) 
                       (a. a  𝒪l  mx' a = mx a)))"
              by (clarsimp simp add: 𝒪l')
            obtain c_undo where c_undo:  "c_undo = (λx. if x  last then c x else c' (Suc last + x - last))"
              by blast
            have c_undo_0: "c_undo 0 = c0"
              by (auto simp add: c_undo c_0)
            from sequence_traces [OF trace_last trace_c', simplified c_last, OF c'_first c_undo]
            have trace_undo: "trace c_undo 0 (last + k)" .
            obtain u_ts u_shared u_m where 
              c_undo_n: "c_undo n = (u_ts,u_m, u_shared)"
              by (cases "c_undo n") 
            with last_bound c'_first c_last
            have c'_suc: "c' (Suc n) = (u_ts,u_m, u_shared)"
              apply (auto simp add: c_undo split: if_split_asm)
              apply (subgoal_tac "n=last")
              apply auto
              done

          
            show ?thesis  
            proof (cases "k < n - last")
              case True
              with c'_unsafe have unsafe: "¬ safe_delayed (c_undo (last + k))"
                by (auto simp add: c_undo c_last c'_first)
              from True have "last + k  n"
                by auto
              from safe_delayed_reach_inter.safe_config [OF this trace_undo, of "last + k"]
              have "safe_delayed (c_undo (last + k))"
                by (auto simp add: c_undo c_0)
              with unsafe have False by simp
              thus ?thesis ..
            next
              case False
              with k_bound have k: "k = n - last"
                by auto
              have eq': "Suc (last + (n - last)) = Suc n"
                using last_bound
                by simp
              from c'_unch [rule_format, of k, simplified k eq', OF _ c_suc c'_suc]
              obtain u_ts_j: "u_ts!j = tsl!j" and
                shared_unch: "a𝒪l. u_shared a = 𝒮l a" and
                shared_orig_unch: "a𝒪l. 𝒮 a = 𝒮l a" and
                mem_unch: "a𝒪l. u_m a = ml a" and 
                mem_unch_orig: "a𝒪l. m a = ml a"
                by auto

              from c'_sim [rule_format, of k, simplified k eq', OF _ c_suc c'_suc] i_bound neq_j_i
              obtain u_ts_i: "u_ts!i = ts!i" and
                 shared_sim: "a. a  𝒪l  u_shared a = 𝒮 a" and
                 mem_sim: "a. a  𝒪l  u_m a = m a"
                by auto
          
              from c'_leq [rule_format, of k] c'_suc c_suc
              have leq_u_ts: "length u_ts = length ts"
                by (auto simp add: eq' k)

              from j_bound leq_u_ts
              have j_bound_u: "j < length u_ts"
                by simp
              from i_bound leq_u_ts
              have i_bound_u: "i < length u_ts"
                by simp
              from k last_bound have l_k_eq: "last + k = n"
                by auto
              from safe_delayed_reach_inter.safe_config [OF _ trace_undo, simplified l_k_eq] 
                k c_0 last_bound
              have safe_delayed_c_undo': "xn. safe_delayed (c_undo x)"
                by (auto simp add: c_undo split: if_split_asm)
              hence safe_delayed_c_undo: "x<n. safe_delayed (c_undo x)"
                by (auto)
              from trace_preserves_simple_ownership_distinct [OF _ trace_undo, 
                simplified l_k_eq c_undo_0, simplified, OF dist this, of n] dist c_undo_n
              have dist_u_ts: "simple_ownership_distinct u_ts"
                by auto
              then interpret dist_u_ts_inter: simple_ownership_distinct u_ts .

              
              {
                fix a
                have "u_m a = m a"
                proof (cases "a  𝒪l") 
                  case True with mem_unch
                  have "u_m a = ml a"
                    by auto
                  moreover
                  from True mem_unch_orig
                  have "m a = ml a" 
                    by auto
                  ultimately show ?thesis by simp
                next
                  case False
                  with mem_sim
                  show ?thesis
                    by auto
                qed
              } hence u_m_eq: "u_m = m" by - (rule ext, auto) 

              {
                fix a
                have "u_shared a = 𝒮 a"
                proof (cases "a  𝒪l") 
                  case True with shared_unch
                  have "u_shared a = 𝒮l a"
                    by auto
                  moreover
                  from True shared_orig_unch
                  have "𝒮 a = 𝒮l a" 
                    by auto
                  ultimately show ?thesis by simp
                next
                  case False
                  with shared_sim
                  show ?thesis
                    by auto
                qed
              } hence u_shared_eq: "u_shared = 𝒮" by - (rule ext, auto) 

              {
                assume safe: "map owned u_ts,map released u_ts,i (is,θ,u_m,𝒟,𝒪,u_shared) "
                then have False
                proof cases
                  case Read
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def split: if_split_asm)
                next
                  case WriteNonVolatile
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def split: if_split_asm)
                next
                  case WriteVolatile
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    apply (auto simp add:eqs races_def split: if_split_asm)
                    apply fastforce
                    done
                next
                  case Fence
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def split: if_split_asm)
                next
                  case Ghost
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    apply (auto simp add:eqs races_def split: if_split_asm)
                    apply fastforce
                    done
                next
                  case (RMWReadOnly cond t a D f ret A L R W)
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
                next
                  case RMWWrite
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    apply (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
                    apply fastforce+
                    done
                next
                  case Nil
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def split: if_split_asm)
                qed
              }
              hence "¬ safe_delayed (u_ts, u_m, u_shared)"
                apply (clarsimp simp add: safe_delayed_def)
                apply (rule_tac x=i in exI)
                using u_ts_i ts_i i_bound_u
                apply auto
                done
              moreover
              from safe_delayed_c_undo' [rule_format, of n] c_undo_n
              have "safe_delayed (u_ts, u_m, u_shared)"
                by simp
              ultimately have False
                by simp
              thus ?thesis 
                by simp
            qed
          next
            case (WriteNonVolatile  a D f A L R W)
            then obtain
              "isl": "isl = Write False a (D, f) A L R W # isl'" and
              θl': "θl' = θl"  and
              sbl': "sbl'=sbl" and
              𝒟l': "𝒟l'=𝒟l" and
              𝒪l': "𝒪l' = 𝒪l" andl': "l'= l" and
              𝒮l': "𝒮l'=𝒮l" and
              ml': "ml' = ml(a:=f θl)"
              by auto
            note eqs' = θl' sbl' 𝒟l' 𝒪l' ℛl' 𝒮l' ml'
            from tsl'_j tsl' ts_j j_boundl eqs'
            obtain eqs: "pl=pj" "isl'=isj" "θl=θj" "𝒟l=𝒟j" "𝒪l=𝒪j" 
              "l=j"
              by auto

            from safel [simplified "isl"]
            obtain a_owned: "a  𝒪l" and a_unshared: "a  dom 𝒮l"
              by cases auto
            have ml_unch_unowned: "a'. a'  𝒪l  ml a' = (ml(a := f θl)) a'" 
            using a_owned by auto

            have ml_unch_unshared: "a'. a'  𝒪l  a'  dom 𝒮l  ml a' = (ml(a := f θl)) a'" 
            using a_unshared by auto
            
            from undo_local_steps [where c=c, OF trace_rest c_last' idle_rest' safe_delayed_last, simplified tsl', 
              simplified,
              OF j_boundl tsl_j [simplified], simplified ml' 𝒮l',OF  ml_unch_unowned ml_unch_unshared, simplified, 
              OF dist_last dist_last' [simplified tsl',simplified] safe_delayed_upto_last]

            obtain c' k where
              k_bound: "k  n - last" and
              trace_c': "trace c' (Suc last) k" and
              c'_first: "c' (Suc last) = (tsl, ml, 𝒮l)" and
              c'_leq: "(xk. length (fst (c' (Suc (last + x)))) = length (fst (c (Suc (last + x)))))" and
              c'_safe: "(x<k. safe_delayed (c' (Suc (last + x))))" and
              c'_unsafe: "(k < n - last  ¬ safe_delayed (c' (Suc (last + k))))" and
              c'_unch: 
               "(xk. tsx 𝒮x mx.
                   c (Suc (last + x)) = (tsx, mx, 𝒮x) 
                   (tsx' 𝒮x' mx'.
                       c' (Suc (last + x)) = (tsx', mx', 𝒮x') 
                       tsx' ! j = tsl ! j 
                       (a𝒪l. 𝒮x' a = 𝒮l a) 
                       (a𝒪l. 𝒮x a = 𝒮l a) 
                       (a𝒪l. mx' a = ml a)  (a'𝒪l. mx a' = (ml(a := f θl)) a')))" and
              c'_sim:
               "(xk. tsx 𝒮x mx.
                   c (Suc (last + x)) = (tsx, mx, 𝒮x) 
                   (tsx' 𝒮x' mx'.
                       c' (Suc (last + x)) = (tsx', mx', 𝒮x') 
                       (ja<length tsx. ja  j  tsx' ! ja = tsx ! ja) 
                       (a. a  𝒪l  𝒮x' a = 𝒮x a) 
                       (a. a  𝒪l  mx' a = mx a)))"
              by (clarsimp simp add: 𝒪l')

            obtain c_undo where c_undo:  "c_undo = (λx. if x  last then c x else c' (Suc last + x - last))"
              by blast
            have c_undo_0: "c_undo 0 = c0"
              by (auto simp add: c_undo c_0)
            from sequence_traces [OF trace_last trace_c', simplified c_last, OF c'_first c_undo]
            have trace_undo: "trace c_undo 0 (last + k)" .
            obtain u_ts u_shared u_m where 
              c_undo_n: "c_undo n = (u_ts,u_m, u_shared)"
              by (cases "c_undo n") 
            with last_bound c'_first c_last
            have c'_suc: "c' (Suc n) = (u_ts,u_m, u_shared)"
              apply (auto simp add: c_undo split: if_split_asm)
              apply (subgoal_tac "n=last")
              apply auto
              done

          
            show ?thesis  
            proof (cases "k < n - last")
              case True
              with c'_unsafe have unsafe: "¬ safe_delayed (c_undo (last + k))"
                by (auto simp add: c_undo c_last c'_first)
              from True have "last + k  n"
                by auto
              from safe_delayed_reach_inter.safe_config [OF this trace_undo, of "last + k"]
              have "safe_delayed (c_undo (last + k))"
                by (auto simp add: c_undo c_0)
              with unsafe have False by simp
              thus ?thesis ..
            next
              case False
              with k_bound have k: "k = n - last"
                by auto
              have eq': "Suc (last + (n - last)) = Suc n"
                using last_bound
                by simp
              from c'_unch [rule_format, of k, simplified k eq', OF _ c_suc c'_suc]
              obtain u_ts_j: "u_ts!j = tsl!j" and
                shared_unch: "a𝒪l. u_shared a = 𝒮l a" and
                shared_orig_unch: "a𝒪l. 𝒮 a = 𝒮l a" and
                mem_unch: "a𝒪l. u_m a = ml a" and 
                mem_unch_orig: "a'𝒪l. m a' = (ml(a := f θl)) a'"
                by auto

              from c'_sim [rule_format, of k, simplified k eq', OF _ c_suc c'_suc] i_bound neq_j_i
              obtain u_ts_i: "u_ts!i = ts!i" and
                 shared_sim: "a. a  𝒪l  u_shared a = 𝒮 a" and
                 mem_sim: "a. a  𝒪l  u_m a = m a"
                by auto
          
              from c'_leq [rule_format, of k] c'_suc c_suc
              have leq_u_ts: "length u_ts = length ts"
                by (auto simp add: eq' k)

              from j_bound leq_u_ts
              have j_bound_u: "j < length u_ts"
                by simp
              from i_bound leq_u_ts
              have i_bound_u: "i < length u_ts"
                by simp
              from k last_bound have l_k_eq: "last + k = n"
                by auto
              from safe_delayed_reach_inter.safe_config [OF _ trace_undo, simplified l_k_eq] 
                k c_0 last_bound
              have safe_delayed_c_undo': "xn. safe_delayed (c_undo x)"
                by (auto simp add: c_undo split: if_split_asm)              
              hence safe_delayed_c_undo: "x<n. safe_delayed (c_undo x)"
                by auto
              from trace_preserves_simple_ownership_distinct [OF _ trace_undo, 
                simplified l_k_eq c_undo_0, simplified, OF dist this, of n] dist c_undo_n
              have dist_u_ts: "simple_ownership_distinct u_ts"
                by auto
              then interpret dist_u_ts_inter: simple_ownership_distinct u_ts .
          (* FIXME delete
              {
                fix a
                have "u_m a = m a"
                proof (cases "a ∈ 𝒪l") 
                  case True with mem_unch
                  have "u_m a = ml a"
                    by auto
                  moreover
                  from True mem_unch_orig
                  have "m a = ml a" 
                    by auto
                  ultimately show ?thesis by simp
                next
                  case False
                  with mem_sim
                  show ?thesis
                    by auto
                qed
              } hence u_m_eq: "u_m = m" by - (rule ext, auto) 
*)
              {
                fix a
                have "u_shared a = 𝒮 a"
                proof (cases "a  𝒪l") 
                  case True with shared_unch
                  have "u_shared a = 𝒮l a"
                    by auto
                  moreover
                  from True shared_orig_unch
                  have "𝒮 a = 𝒮l a" 
                    by auto
                  ultimately show ?thesis by simp
                next
                  case False
                  with shared_sim
                  show ?thesis
                    by auto
                qed
              } hence u_shared_eq: "u_shared = 𝒮" by - (rule ext, auto) 

              {
                assume safe: "map owned u_ts,map released u_ts,i (is,θ,u_m,𝒟,𝒪,u_shared) "
                then have False
                proof cases
                  case Read
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def split: if_split_asm)
                next
                  case WriteNonVolatile
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def split: if_split_asm)
                next
                  case WriteVolatile
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    apply (auto simp add:eqs races_def split: if_split_asm)
                    apply fastforce
                    done
                next
                  case Fence
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def split: if_split_asm)
                next
                  case Ghost
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    apply (auto simp add:eqs races_def split: if_split_asm)
                    apply fastforce
                    done
                next
                  case (RMWReadOnly cond t a' D f ret A L R W)
                  with ts_i "is" obtain
                    ins: "ins = RMW a' t (D, f) cond ret A L R W" and
                    owned_or_shared: "a'  𝒪  a'  dom u_shared" and
                    cond: "¬ cond (θ(t  u_m a'))" and
                    rels_race: "j<length (map owned u_ts). i  j  ((map released u_ts) ! j) a'  Some False"
                    by auto
                  from dist_u_ts_inter.simple_ownership_distinct [OF j_bound_u i_bound_u neq_j_i u_ts_j [simplified tsl_j] 
                    u_ts_i [simplified ts_i]] 
                  have dist: "𝒪l  𝒪 = {}"
                    by auto
                  from owned_or_shared dist a_owned a_unshared shared_orig_unch
                  have a'_a: "a'a"
                    by (auto simp add: u_shared_eq domIff)
                  have u_m_eq: "u_m a' = m a'"
                  proof (cases "a'  𝒪l") 
                    case True with mem_unch
                    have "u_m a' = ml a'"
                      by auto
                    moreover
                    from True mem_unch_orig a'_a
                    have "m a' = ml a'" 
                      by auto
                    ultimately show ?thesis by simp
                  next
                    case False
                    with mem_sim
                    show ?thesis
                      by auto
                  qed
                  with ins cond rels_race show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
                next
                  case (RMWWrite cond t a' A L R D f ret W)
                  with ts_i "is" obtain
                    ins: "ins = RMW a' t (D, f) cond ret A L R W" and
                    cond: "cond (θ(t  u_m a'))" and
                    a': "j<length (map owned u_ts). i  j  a'  (map owned u_ts) ! j  dom ((map released u_ts) ! j)" and
                    safety:
                      "A  dom u_shared  𝒪" "L  A" "R  𝒪" "A  R = {}"
                      "j<length (map owned u_ts). i  j  A  ((map owned u_ts) ! j  dom ((map released u_ts) ! j)) = {}"
                      "a'  read_only u_shared"
                    by auto
                  from a'[rule_format, of j] j_bound_u u_ts_j tsl_j neq_j_i
                  have "a'  𝒪l"
                    by auto
                  from mem_sim [rule_format, OF this]
                  have u_m_eq: "u_m a' = m a'"
                    by auto
                  
                  with ins cond safety a' show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    apply (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
                    apply fastforce
                    done
                next
                  case Nil
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def split: if_split_asm)
                qed
              }
              hence "¬ safe_delayed (u_ts, u_m, u_shared)"
                apply (clarsimp simp add: safe_delayed_def)
                apply (rule_tac x=i in exI)
                using u_ts_i ts_i i_bound_u
                apply auto
                done
              moreover
              from safe_delayed_c_undo' [rule_format, of n] c_undo_n
              have "safe_delayed (u_ts, u_m, u_shared)"
                by simp
              ultimately have False
                by simp
              thus ?thesis 
                by simp
            qed
          next
            case WriteVolatile
            with tsl'_j tsl' ts_j j_boundl have "j = Map.empty"
              by auto
            withj_non_empty have False by auto
            thus ?thesis ..
          next
            case Fence
            with tsl'_j tsl' ts_j j_boundl have "j = Map.empty"
              by auto
            withj_non_empty have False by auto
            thus ?thesis ..
          next
            case RMWReadOnly
            with tsl'_j tsl' ts_j j_boundl have "j = Map.empty"
              by auto
            withj_non_empty have False by auto
            thus ?thesis ..
          next
            case RMWWrite
            with tsl'_j tsl' ts_j j_boundl have "j = Map.empty"
              by auto
            withj_non_empty have False by auto
            thus ?thesis ..
          next
            case (Ghost A L R W)
            then obtain
              "isl": "isl = Ghost A L R W # isl'" and
              θl': "θl' = θl"  and
              sbl': "sbl'=sbl" and
              𝒟l': "𝒟l'=𝒟l" and
              𝒪l': "𝒪l' = 𝒪l  A - R" andl': "l'= augment_rels (dom 𝒮l) R l" and
              𝒮l': "𝒮l'=𝒮lW RA L" and
              ml': "ml' = ml"
              by auto
            note eqs' = θl' sbl' 𝒟l' 𝒪l' ℛl' 𝒮l' ml'
            from tsl'_j tsl' ts_j j_boundl eqs'
            obtain eqs: "pl=pj" "isl'=isj" "θl=θj" "𝒟l=𝒟j" "𝒪l  A - R = 𝒪j" 
              "augment_rels (dom 𝒮l) R l=j"
              by auto

            from safel [simplified "isl"]
            obtain
            A_shared_owned: "A  dom 𝒮l  𝒪l" and L_A: "L  A" and R_owns: "R  𝒪l" and A_R: "A  R = {}" and
            "j' < length (map owned tsl). jj'   A  ((map owned tsl)!j'  dom ((map released tsl)!j')) = {}"
              by cases auto


            from A_shared_owned L_A R_owns A_R
            have shared_eq: "a. a  𝒪l  a  𝒪l'  𝒮l a = (𝒮lW RA L) a"
              by (auto simp add: restrict_shared_def augment_shared_def 𝒪l' split: option.splits)
            
            from undo_local_steps [where c=c, OF trace_rest c_last' idle_rest' safe_delayed_last, simplified tsl', 
              simplified,
              OF j_boundl tsl_j [simplified], simplified ml' 𝒮l', simplified, 
              OF  shared_eq dist_last dist_last' [simplified tsl',simplified] safe_delayed_upto_last]

            obtain c' k where
              k_bound: "k  n - last" and
              trace_c': "trace c' (Suc last) k" and
              c'_first: "c' (Suc last) = (tsl, ml, 𝒮l)" and
              c'_leq: "(xk. length (fst (c' (Suc (last + x)))) = length (fst (c (Suc (last + x)))))" and
              c'_safe: "(x<k. safe_delayed (c' (Suc (last + x))))" and
              c'_unsafe: "(k < n - last  ¬ safe_delayed (c' (Suc (last + k))))" and
              c'_unch: 
               "(xk. tsx 𝒮x mx.
                   c (Suc (last + x)) = (tsx, mx, 𝒮x) 
                   (tsx' 𝒮x' mx'.
                       c' (Suc (last + x)) = (tsx', mx', 𝒮x') 
                       tsx' ! j = tsl ! j 
                       (a𝒪l. 𝒮x' a = 𝒮l a) 
                       (a𝒪l. 𝒮x a = (𝒮lW RA L) a) 
                       (a𝒪l. mx' a = ml a)  (a'𝒪l. mx a' = (ml) a')))" and
              c'_sim:
               "(xk. tsx 𝒮x mx.
                   c (Suc (last + x)) = (tsx, mx, 𝒮x) 
                   (tsx' 𝒮x' mx'.
                       c' (Suc (last + x)) = (tsx', mx', 𝒮x') 
                       (ja<length tsx. ja  j  tsx' ! ja = tsx ! ja) 
                       (a. a  𝒪l  a  𝒪l'  𝒮x' a = 𝒮x a) 
                       (a. a  𝒪l  mx' a = mx a)))"

              by (clarsimp )
            obtain c_undo where c_undo:  "c_undo = (λx. if x  last then c x else c' (Suc last + x - last))"
              by blast
            have c_undo_0: "c_undo 0 = c0"
              by (auto simp add: c_undo c_0)
            from sequence_traces [OF trace_last trace_c', simplified c_last, OF c'_first c_undo]
            have trace_undo: "trace c_undo 0 (last + k)" .
            obtain u_ts u_shared u_m where 
              c_undo_n: "c_undo n = (u_ts,u_m, u_shared)"
              by (cases "c_undo n") 
            with last_bound c'_first c_last
            have c'_suc: "c' (Suc n) = (u_ts,u_m, u_shared)"
              apply (auto simp add: c_undo split: if_split_asm)
              apply (subgoal_tac "n=last")
              apply auto
              done

          
            show ?thesis  
            proof (cases "k < n - last")
              case True
              with c'_unsafe have unsafe: "¬ safe_delayed (c_undo (last + k))"
                by (auto simp add: c_undo c_last c'_first)
              from True have "last + k  n"
                by auto
              from safe_delayed_reach_inter.safe_config [OF this trace_undo, of "last + k"]
              have "safe_delayed (c_undo (last + k))"
                by (auto simp add: c_undo c_0)
              with unsafe have False by simp
              thus ?thesis ..
            next
              case False
              with k_bound have k: "k = n - last"
                by auto
              have eq': "Suc (last + (n - last)) = Suc n"
                using last_bound
                by simp
              from c'_unch [rule_format, of k, simplified k eq', OF _ c_suc c'_suc]
              obtain u_ts_j: "u_ts!j = tsl!j" and
                shared_unch: "a𝒪l. u_shared a = 𝒮l a" and
                shared_orig_unch: "a𝒪l. 𝒮 a = (𝒮lW RA L) a" and
                mem_unch: "a𝒪l. u_m a = ml a" and 
                mem_unch_orig: "a'𝒪l. m a' = ml a'"
                by auto

              from c'_sim [rule_format, of k, simplified k eq', OF _ c_suc c'_suc] i_bound neq_j_i
              obtain u_ts_i: "u_ts!i = ts!i" and
                 shared_sim: "a. a  𝒪l  a  𝒪l'  u_shared a = 𝒮 a" and
                 mem_sim: "a. a  𝒪l  u_m a = m a"
                by auto
          
              from c'_leq [rule_format, of k] c'_suc c_suc
              have leq_u_ts: "length u_ts = length ts"
                by (auto simp add: eq' k)

              from j_bound leq_u_ts
              have j_bound_u: "j < length u_ts"
                by simp
              from i_bound leq_u_ts
              have i_bound_u: "i < length u_ts"
                by simp
              from k last_bound have l_k_eq: "last + k = n"
                by auto
              from safe_delayed_reach_inter.safe_config [OF _ trace_undo, simplified l_k_eq] 
                k c_0 last_bound
              have safe_delayed_c_undo': "xn. safe_delayed (c_undo x)"
                by (auto simp add: c_undo split: if_split_asm)              
              hence safe_delayed_c_undo: "x<n. safe_delayed (c_undo x)"
                by auto
              from trace_preserves_simple_ownership_distinct [OF _ trace_undo, 
                simplified l_k_eq c_undo_0, simplified, OF dist this, of n] dist c_undo_n
              have dist_u_ts: "simple_ownership_distinct u_ts"
                by auto
              then interpret dist_u_ts_inter: simple_ownership_distinct u_ts .
              {
                fix a
                have "u_m a = m a"
                proof (cases "a  𝒪l") 
                  case True with mem_unch
                  have "u_m a = ml a"
                    by auto
                  moreover
                  from True mem_unch_orig
                  have "m a = ml a" 
                    by auto
                  ultimately show ?thesis by simp
                next
                  case False
                  with mem_sim
                  show ?thesis
                    by auto
                qed
              } hence u_m_eq: "u_m = m" by - (rule ext, auto) 
              {
                assume safe: "map owned u_ts,map released u_ts,i (is,θ,u_m,𝒟,𝒪,u_shared) "
                then have False
                proof cases
                  case (Read a volatile t)
                  with ts_i "is" obtain
                    ins: "ins = Read volatile a t"  and
                    access_cond: "a  𝒪  a  read_only u_shared  volatile  a  dom u_shared" and
                    rels_cond: "j<length u_ts. i  j  ((map released u_ts) ! j) a  Some False" and
                    rels_non_volatile_cond: "¬ volatile  (j<length u_ts. i  j  a  dom ((map released u_ts) ! j) )" and
                    clean: "volatile  ¬ 𝒟"
                    by auto

                  from race ts_j
                  have rc: "augment_rels (dom 𝒮l) R l a = Some False  
                            (¬ volatile  a  dom (augment_rels (dom 𝒮l) R l))"
                    by (auto simp add: races_def ins eqs)
                  from rels_cond [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j tsl_j j_bound_u
                  havel_a: "l a  Some False"
                    by auto
                  from dist_u_ts_inter.simple_ownership_distinct [OF j_bound_u i_bound_u neq_j_i u_ts_j [simplified tsl_j] 
                    u_ts_i [simplified ts_i]] 
                  have dist: "𝒪l  𝒪 = {}"
                    by auto

                  show ?thesis 
                  proof (cases volatile)
                    case True
                    note volatile=this
                    show ?thesis
                    proof (cases "a  R")
                      case False 
                      with rc ℛl_a show False
                        by (auto simp add: augment_rels_def volatile)
                    next
                      case True
                      with R_owns
                      have a_ownsl: "a  𝒪l"
                        by auto
                      from shared_unch [rule_format, OF a_ownsl]
                      have u_shared_eq: "u_shared a = 𝒮l a"
                        by auto
                      from a_ownsl dist have "a  𝒪"
                        by auto
                      moreover
                      {
                        assume "a  read_only u_shared"
                        with u_shared_eq have "𝒮l a = Some False"
                          by (auto simp add: read_only_def)
                        with rc True ℛl_a have False
                          by (auto simp add: augment_rels_def split: option.splits simp add: domIff volatile)
                      }
                      moreover
                      {
                        assume "a  dom u_shared"
                        with u_shared_eq rc True ℛl_a have False
                          by (auto simp add: augment_rels_def split: option.splits simp add: domIff volatile)
                      }
                      ultimately show False
                      using access_cond 
                        by auto
                    qed
                  next
                    case False
                    note non_volatile = this
                    from rels_non_volatile_cond [rule_format, OF False j_bound_u neq_j_i [symmetric]] u_ts_j tsl_j j_bound_u
                    havel_a: "l a = None"
                      by (auto simp add: domIff)
                    show ?thesis
                    proof (cases "a  R")
                      case False 
                      with rc ℛl_a show False
                        by (auto simp add: augment_rels_def non_volatile domIff)
                    next
                      case True
                      with R_owns
                      have a_ownsl: "a  𝒪l"
                        by auto
                      from shared_unch [rule_format, OF a_ownsl]
                      have u_shared_eq: "u_shared a = 𝒮l a"
                        by auto
                      from a_ownsl dist have a_unowned: "a  𝒪"
                        by auto
                      moreover
                      from ro_last_last interpret
                      read_only_unowned 𝒮l tsl .
                      from read_only_unowned [OF j_boundl tsl_j] a_ownsl have a_unsh: "a   read_only 𝒮l" by auto
                      {
                        assume "a  read_only u_shared"
                        with u_shared_eq have sh: "𝒮l a = Some False"
                          by (auto simp add: read_only_def)
                        
                        with rc True ℛl_a access_cond u_shared_eq a_unowned sh a_ownsl a_unsh have False
                          by (auto simp add: augment_rels_def split: option.splits simp add: domIff non_volatile read_only_def)
                      }
                      moreover
                      {
                        assume "a  dom u_shared"
                        with u_shared_eq rc True ℛl_a a_ownsl a_unsh access_cond dist have False
                          by (auto simp add: augment_rels_def split: option.splits simp add: domIff non_volatile read_only_def)
                      }
                      ultimately show False
                      using access_cond 
                        by (auto)
                    qed
                  qed
                next
                  case (WriteNonVolatile a D f A' L' R' W')
                  with ts_i "is" obtain
                    ins: "ins = Write False a (D, f) A' L' R' W'"  and
                    a_owned: "a  𝒪" and a_unshared: "a  dom u_shared" and
                    a_unreleased: "j<length u_ts. i  j  a  dom ((map released u_ts) ! j)"
                    by auto
                  from dist_u_ts_inter.simple_ownership_distinct [OF j_bound_u i_bound_u neq_j_i u_ts_j [simplified tsl_j] 
                    u_ts_i [simplified ts_i]] 
                  have dist: "𝒪l  𝒪 = {}"
                    by auto
                  from race ts_j
                  have rc: "a  dom (augment_rels (dom 𝒮l) R l)"
                    by (auto simp add: races_def ins eqs)
                  from a_unreleased [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j tsl_j j_bound_u
                  havel_a: "a  dom l"
                    by auto
                  show False
                  proof (cases "a  R")
                    case False 
                    with rc ℛl_a show False
                      by (auto simp add: augment_rels_def domIff)
                  next
                    case True
                    with R_owns
                    have a_ownsl: "a  𝒪l"
                      by auto
                    with a_owned dist show False
                      by auto
                  qed
                next
                  case (WriteVolatile a A' L' R' D f W')
                  with ts_i "is" obtain
                    ins: "ins = Write True a (D, f) A' L' R' W'"  and
                    a_un_owned_released: "j<length u_ts. i  j  
                      a  ((map owned u_ts) ! j)  a  dom ((map released u_ts) ! j)" and
                    A'_owns_shared: "A'  dom u_shared  𝒪" and
                    L'_A': "L'  A'" and
                    R'_owned: "R'  𝒪" and
                    A'_R': "A'  R' = {}" and
                    acq_ok: "j<length u_ts. i  j  A'  ((map owned u_ts) ! j  dom ((map released u_ts) ! j)) = {}" and
                   
                    writeable: "a  read_only u_shared"
                    by auto
                  from a_un_owned_released [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j tsl_j j_bound_u
                  obtain 𝒪l_a: "a  𝒪l" andl_a: "a  dom (l)"
                    by auto
                  from acq_ok [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j tsl_j j_bound_u
                  obtain 𝒪l_A': "A'  𝒪l = {}" andl_A': "A'  dom (l) = {}"
                    by auto
                  {
                    assume rc: "a  dom (augment_rels (dom 𝒮l) R l)"
                    have False
                    proof (cases "a  R")
                      case False 
                      with rc ℛl_a show False
                        by (auto simp add: augment_rels_def domIff)
                    next
                      case True
                      with R_owns
                      have a_ownsl: "a  𝒪l"
                        by auto
                      with 𝒪l_a show False
                        by auto
                    qed
                  }
                  moreover 
                  {
                    assume rc: "A'  dom (augment_rels (dom 𝒮l) R l)  {}"
                    then obtain a' where a'_A': "a'  A'" and a'_aug: "a'  dom (augment_rels (dom 𝒮l) R l)"
                      by auto
                    have False
                    proof (cases "a'  R")
                      case False 
                      with a'_aug a'_A' ℛl_A' show False
                        by (auto simp add: augment_rels_def domIff)
                    next
                      case True
                      with R_owns have a'_ownsl: "a'  𝒪l"
                        by auto
                      with 𝒪l_A' a'_A' show False
                        by auto
                    qed
                  }
                  ultimately show False
                  using race ts_j 
                    by (auto simp add: races_def ins eqs)
                next
                  case Fence
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def split: if_split_asm)
                next
                  case (Ghost A' L' R' W')
                  with ts_i "is" obtain
                    ins: "ins = Ghost A' L' R' W'"  and
                    A'_owns_shared: "A'  dom u_shared  𝒪" and
                    L'_A': "L'  A'" and
                    R'_owned: "R'  𝒪" and
                    A'_R': "A'  R' = {}" and
                    acq_ok: "j<length u_ts. i  j  A'  ((map owned u_ts) ! j  dom ((map released u_ts) ! j)) = {}" 
                    by auto
                  from acq_ok [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j tsl_j j_bound_u
                  obtain 𝒪l_A': "A'  𝒪l = {}" andl_A': "A'  dom (l) = {}"
                    by auto
                  
                  from race ts_j 
                  obtain a'  where a'_A': "a'  A'" and 
                    a'_aug: "a'  dom (augment_rels (dom 𝒮l) R l)"
                    by (auto simp add: races_def ins eqs)
                  show False
                  proof (cases "a'  R")
                    case False 
                    with a'_aug a'_A' ℛl_A' show False
                      by (auto simp add: augment_rels_def domIff)
                  next
                    case True
                    with R_owns have a'_ownsl: "a'  𝒪l"
                      by auto
                    with 𝒪l_A' a'_A' show False
                      by auto
                  qed
                next
                  case (RMWReadOnly cond t a D f ret A' L' R' W')
                  with ts_i "is" obtain
                    ins: "ins = RMW a t (D, f) cond ret A' L' R' W'" and
                    owned_or_shared: "a  𝒪  a  dom u_shared" and
                    cond: "¬ cond (θ(t  u_m a))" and
                    rels_race: "j<length (map owned u_ts). i  j  ((map released u_ts) ! j) a  Some False"
                    by auto
                  from dist_u_ts_inter.simple_ownership_distinct [OF j_bound_u i_bound_u neq_j_i u_ts_j [simplified tsl_j] 
                    u_ts_i [simplified ts_i]] 
                  have dist: "𝒪l  𝒪 = {}"
                    by auto
                  from race ts_j cond
                  have rc: "augment_rels (dom 𝒮l) R l a = Some False"
                    by (auto simp add: races_def ins eqs u_m_eq)

                  from rels_race [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] 
                    u_ts_j tsl_j j_bound_u
                  havel_a: "l a  Some False"
                    by auto

                  show ?thesis
                  proof (cases "a  R")
                    case False 
                    with rc ℛl_a show False
                      by (auto simp add: augment_rels_def)
                  next
                    case True
                    with R_owns
                    have a_ownsl: "a  𝒪l"
                      by auto
                    from shared_unch [rule_format, OF a_ownsl]
                    have u_shared_eq: "u_shared a = 𝒮l a"
                      by auto
                    from a_ownsl dist have "a  𝒪"
                      by auto
                    with u_shared_eq rc True ℛl_a owned_or_shared show False
                      by (auto simp add: augment_rels_def split: option.splits simp add: domIff)
                  qed
                next
                  case (RMWWrite cond t a A' L' R' D f ret W')
                  with ts_i "is" obtain
                    ins: "ins = RMW a t (D, f) cond ret A' L' R' W'" and
                    cond: "cond (θ(t  u_m a))" and
                    a_un_owned_released: "j<length (map owned u_ts). i  j  a  (map owned u_ts) ! j  dom ((map released u_ts) ! j)" and
                    A'_owns_shared:"A'  dom u_shared  𝒪" and
                    L'_A': "L'  A'" and
                    R'_owned: "R'  𝒪" and
                    A'_R': "A'  R' = {}" and
                    acq_ok: "j<length (map owned u_ts). i  j  A'  ((map owned u_ts) ! j  dom ((map released u_ts) ! j)) = {}" and 
                    writeable: "a  read_only u_shared"
                    by auto


                  from a_un_owned_released [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j tsl_j j_bound_u
                  obtain 𝒪l_a: "a  𝒪l" andl_a: "a  dom (l)"
                    by auto
                  from acq_ok [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j tsl_j j_bound_u
                  obtain 𝒪l_A': "A'  𝒪l = {}" andl_A': "A'  dom (l) = {}"
                    by auto
                  {
                    assume rc: "a  dom (augment_rels (dom 𝒮l) R l)"
                    have False
                    proof (cases "a  R")
                      case False 
                      with rc ℛl_a show False
                        by (auto simp add: augment_rels_def domIff)
                    next
                      case True
                      with R_owns
                      have a_ownsl: "a  𝒪l"
                        by auto
                      with 𝒪l_a show False
                        by auto
                    qed
                  }
                  moreover 
                  {
                    assume rc: "A'  dom (augment_rels (dom 𝒮l) R l)  {}"
                    then obtain a' where a'_A': "a'  A'" and a'_aug: "a'  dom (augment_rels (dom 𝒮l) R l)"
                      by auto
                    have False
                    proof (cases "a'  R")
                      case False 
                      with a'_aug a'_A' ℛl_A' show False
                        by (auto simp add: augment_rels_def domIff)
                    next
                      case True
                      with R_owns have a'_ownsl: "a'  𝒪l"
                        by auto
                      with 𝒪l_A' a'_A' show False
                        by auto
                    qed
                  }
                  ultimately show False
                  using race ts_j cond
                    by (auto simp add: races_def ins eqs u_m_eq)
                next
                next
                  case Nil
                  then show ?thesis
                  using  ts_i tsl_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
                    by (auto simp add:eqs races_def split: if_split_asm)
                qed
              }
              hence "¬ safe_delayed (u_ts, u_m, u_shared)"
                apply (clarsimp simp add: safe_delayed_def)
                apply (rule_tac x=i in exI)
                using u_ts_i ts_i i_bound_u
                apply auto
                done
              moreover
              from safe_delayed_c_undo' [rule_format, of n] c_undo_n
              have "safe_delayed (u_ts, u_m, u_shared)"
                by simp
              ultimately have False
                by simp
              thus ?thesis 
                by simp
            qed
          qed
        next
          case (StoreBuffer _ p "is" θ sb 𝒟 𝒪  sb' 𝒪' ℛ')
          hence False 
            by (auto simp add: empty_storebuffer_step_def)
          thus ?thesis ..
        qed
      qed
      } (* FIXME indentation *)
      ultimately show ?thesis
      using last_action_of_thread [where i=j, OF trace]
         by blast
   qed
 qed(* FIXME indentation *)

datatype 'p memref = 
   Writesb bool addr sop val acq lcl rel wrt
 | Readsb bool addr tmp val 
 | Progsb 'p 'p "instrs"
 | Ghostsb acq lcl rel wrt

type_synonym 'p store_buffer = "'p memref list"
inductive flush_step:: "memory × 'p store_buffer × owns × rels × shared  memory × 'p store_buffer × owns × rels × shared  bool" 
  ("_ f _" [60,60] 100)
where
  Writesb: "𝒪' = (if volatile then 𝒪  A - R else 𝒪);
           𝒮' = (if volatile then 𝒮W RA L else 𝒮);
          ℛ'=(if volatile then Map.empty else )
          
          (m, Writesb volatile a sop v A L R W# rs,𝒪,,𝒮) f (m(a := v), rs,𝒪',ℛ',𝒮')"
| Readsb: "(m, Readsb volatile a t v#rs,𝒪,,𝒮) f (m, rs,𝒪,, 𝒮)"
| Progsb: "(m, Progsb p p' is#rs,𝒪,, 𝒮) f (m, rs,𝒪,, 𝒮)"
| Ghost: "(m, Ghostsb A L R W# rs,𝒪,,𝒮) f (m, rs,𝒪  A - R, augment_rels (dom 𝒮) R , 𝒮W RA L )"

abbreviation flush_steps::"memory × 'p store_buffer × owns × rels × shared  memory × 'p store_buffer × owns × rels × shared bool" 
  ("_ f* _" [60,60] 100)
where
"flush_steps == flush_step^**"

term "x f* Y"

lemmas flush_step_induct =  
  flush_step.induct [split_format (complete),
  consumes 1, case_names Writesb Readsb Progsb Ghost]

inductive store_buffer_step:: "memory × 'p store_buffer × 'owns × 'rels × 'shared  memory × 'p memref list × 'owns × 'rels × 'shared  bool" 
  ("_ w _" [60,60] 100)
where
  SBWritesb: "
          (m, Writesb volatile a sop v A L R W# rs,𝒪,,𝒮) w (m(a := v), rs,𝒪,,𝒮)"

abbreviation store_buffer_steps::"memory × 'p store_buffer × 'owns × 'rels × 'shared  memory × 'p store_buffer × 'owns × 'rels × 'shared bool" 
  ("_ →w* _" [60,60] 100)
where
"store_buffer_steps == store_buffer_step^**"

term "x →w* Y"

fun buffered_val :: "'p memref list  addr  val option"
where
  "buffered_val [] a = None"
| "buffered_val (r # rs) a' = 
   (case r of
      Writesb volatile a _ v _ _ _ _  (case buffered_val rs a' of 
                               None  (if a'=a then Some v else None)
                             | Some v'  Some v')
     | _  buffered_val rs a')"

definition address_of :: "'p memref  addr set"
where
"address_of r = (case r of Writesb volatile a _ v _ _ _ _  {a} | Readsb volatile a t v  {a} |
                  _  {})"

lemma address_of_simps [simp]: 
"address_of (Writesb volatile a sop v A L R W) = {a}"
"address_of (Readsb volatile a t v) = {a}"
"address_of (Progsb p p' is) = {}"
"address_of (Ghostsb A L R W) = {}"
  by (auto simp add: address_of_def)

definition is_volatile :: "'p memref  bool"
where
"is_volatile r = (case r of Writesb volatile a _ v _ _ _ _ volatile | Readsb volatile a t v  volatile
 | _  False)"

lemma is_volatile_simps [simp]: 
"is_volatile (Writesb volatile a sop v A L R W) = volatile"
"is_volatile (Readsb volatile a t v) = volatile"
"is_volatile (Progsb p p' is) = False"
"is_volatile (Ghostsb A L R W) = False"
  by (auto simp add: is_volatile_def)

definition is_Writesb:: "'p memref  bool"
where
"is_Writesb r = (case r of Writesb volatile a _ v _ _ _ _ True | _  False)"

definition is_Readsb:: "'p memref  bool"
where
"is_Readsb r = (case r of Readsb volatile a t v  True | _  False)"

definition is_Progsb:: "'p memref  bool"
where
"is_Progsb r = (case r of Progsb _ _ _  True | _  False)"

definition is_Ghostsb:: "'p memref  bool"
where
"is_Ghostsb r = (case r of Ghostsb _ _ _ _  True | _  False)"

lemma is_Writesb_simps [simp]: 
"is_Writesb (Writesb volatile a sop v A L R W) = True"
"is_Writesb (Readsb volatile a t v) = False"
"is_Writesb (Progsb p p' is) = False"
"is_Writesb (Ghostsb A L R W) = False"
  by (auto simp add: is_Writesb_def)

lemma is_Readsb_simps [simp]: 
"is_Readsb (Readsb volatile a t v) = True"
"is_Readsb (Writesb volatile a sop v A L R W) = False"
"is_Readsb (Progsb p p' is) = False"
"is_Readsb (Ghostsb A L R W) = False"
  by (auto simp add: is_Readsb_def)

lemma is_Progsb_simps [simp]: 
"is_Progsb (Readsb volatile a t v) = False"
"is_Progsb (Writesb volatile a sop v A L R W) = False"
"is_Progsb (Progsb p p' is) = True"
"is_Progsb (Ghostsb A L R W) = False"
  by (auto simp add: is_Progsb_def)

lemma is_Ghostsb_simps [simp]: 
"is_Ghostsb (Readsb volatile a t v) = False"
"is_Ghostsb (Writesb volatile a sop v A L R W) = False"
"is_Ghostsb (Progsb p p' is) = False"
"is_Ghostsb (Ghostsb A L R W) = True"
  by (auto simp add: is_Ghostsb_def)

definition is_volatile_Writesb:: "'p memref  bool"
where
"is_volatile_Writesb r = (case r of Writesb volatile a _ v _ _ _ _ volatile | _  False)"

lemma is_volatile_Writesb_simps [simp]: 
"is_volatile_Writesb (Writesb volatile a sop v A L R W) = volatile"
"is_volatile_Writesb (Readsb volatile a t v) = False"
"is_volatile_Writesb (Progsb p p' is) = False"
"is_volatile_Writesb (Ghostsb A L R W) = False"
  by (auto simp add: is_volatile_Writesb_def)

lemma is_volatile_Writesb_address_of [simp]: "is_volatile_Writesb x  address_of x  {}"
  by (cases x) auto

definition is_volatile_Readsb:: "'p memref  bool"
where
"is_volatile_Readsb r = (case r of Readsb volatile a t v  volatile | _  False)"

lemma is_volatile_Readsb_simps [simp]: 
"is_volatile_Readsb (Readsb volatile a t v) = volatile"
"is_volatile_Readsb (Writesb volatile a sop v A L R W) = False"
"is_volatile_Readsb (Progsb p p' is) = False"
"is_volatile_Readsb (Ghostsb A L R W) = False"
  by (auto simp add: is_volatile_Readsb_def)

definition is_non_volatile_Writesb:: "'p memref  bool"
where
"is_non_volatile_Writesb r = (case r of Writesb volatile a _ v _ _ _ _ ¬ volatile | _  False)"

lemma is_non_volatile_Writesb_simps [simp]: 
"is_non_volatile_Writesb (Writesb volatile a sop v A L R W) = (¬ volatile)"
"is_non_volatile_Writesb (Readsb volatile a t v) = False"
"is_non_volatile_Writesb (Progsb p p' is) = False"
"is_non_volatile_Writesb (Ghostsb A L R W) = False"
  by (auto simp add: is_non_volatile_Writesb_def)

definition is_non_volatile_Readsb:: "'p memref  bool"
where
"is_non_volatile_Readsb r = (case r of Readsb volatile a t v  ¬ volatile | _  False)"

lemma is_non_volatile_Readsb_simps [simp]: 
"is_non_volatile_Readsb (Readsb volatile a t v) = (¬ volatile)"
"is_non_volatile_Readsb (Writesb volatile a sop v A L R W) = False"
"is_non_volatile_Readsb (Progsb p p' is) = False"
"is_non_volatile_Readsb (Ghostsb A L R W) = False"
  by (auto simp add: is_non_volatile_Readsb_def)

lemma is_volatile_split: "is_volatile r = 
  (is_volatile_Readsb r  is_volatile_Writesb r)"
  by (cases r) auto

lemma is_non_volatile_split: 
  "¬ is_volatile r = (is_non_volatile_Readsb r  is_non_volatile_Writesb r  is_Progsb r  is_Ghostsb r)"
  by (cases r) auto

fun outstanding_refs:: "('p memref  bool)  'p memref list  addr set"
where
  "outstanding_refs P [] = {}"
| "outstanding_refs P (r#rs) = (if P r then (address_of r)  (outstanding_refs P rs)
                                else outstanding_refs P rs)"

lemma outstanding_refs_conv: "outstanding_refs P sb = (address_of ` {r. r  set sb  P r})"
  by (induct sb) auto

lemma outstanding_refs_append: 
  "ys. outstanding_refs vol (xs@ys) = outstanding_refs vol xs  outstanding_refs vol ys"
  by (auto simp add: outstanding_refs_conv)

(*
lemma outstanding_refs_empty_conv:
"(outstanding_refs P sb = {}) = (∀r ∈ set sb. ¬ (P r))"
  by (auto simp add: outstanding_refs_conv)
*)

lemma outstanding_refs_empty_negate: "(outstanding_refs P sb = {})  
       (outstanding_refs (Not  P) sb = (address_of ` set sb))"
  by (auto simp add: outstanding_refs_conv)

lemma outstanding_refs_mono_pred:
  "sb sb'. 
     r. P r  P' r  outstanding_refs P sb  outstanding_refs P' sb"
  by (auto simp add: outstanding_refs_conv)

lemma outstanding_refs_mono_set:
  "sb sb'. 
     set sb  set sb'  outstanding_refs P sb  outstanding_refs P sb'"
  by (auto simp add: outstanding_refs_conv)

lemma outstanding_refs_takeWhile:
"outstanding_refs P (takeWhile P' sb)  outstanding_refs P sb"
apply (rule outstanding_refs_mono_set)
apply (auto dest: set_takeWhileD)
done

lemma outstanding_refs_subsets:
  "outstanding_refs is_volatile_Writesb sb  outstanding_refs is_Writesb sb"
  "outstanding_refs is_non_volatile_Writesb sb  outstanding_refs is_Writesb sb"

  "outstanding_refs is_volatile_Readsb sb  outstanding_refs is_Readsb sb"
  "outstanding_refs is_non_volatile_Readsb sb  outstanding_refs is_Readsb sb"

  "outstanding_refs is_non_volatile_Writesb sb  outstanding_refs (Not  is_volatile) sb"
  "outstanding_refs is_non_volatile_Readsb sb  outstanding_refs (Not  is_volatile) sb"

  "outstanding_refs is_volatile_Writesb sb  outstanding_refs (is_volatile) sb"
  "outstanding_refs is_volatile_Readsb sb  outstanding_refs (is_volatile) sb"

  "outstanding_refs is_non_volatile_Writesb sb  outstanding_refs (Not  is_volatile_Writesb) sb"
  "outstanding_refs is_non_volatile_Readsb sb  outstanding_refs (Not  is_volatile_Writesb) sb"
  "outstanding_refs is_volatile_Readsb sb  outstanding_refs (Not  is_volatile_Writesb) sb"
  "outstanding_refs is_Readsb sb  outstanding_refs (Not  is_volatile_Writesb) sb"
by (auto intro!:outstanding_refs_mono_pred simp add: is_volatile_Writesb_def is_non_volatile_Writesb_def 
  is_volatile_Readsb_def is_non_volatile_Readsb_def is_Readsb_def split: memref.splits)


lemma outstanding_non_volatile_refs_conv: 
  "outstanding_refs (Not  is_volatile) sb =
   outstanding_refs is_non_volatile_Writesb sb  outstanding_refs is_non_volatile_Readsb sb"
apply (induct sb) 
apply simp
  subgoal for a sb
    by (case_tac a, auto)
done


lemma outstanding_volatile_refs_conv: 
  "outstanding_refs is_volatile sb =
   outstanding_refs is_volatile_Writesb sb  outstanding_refs is_volatile_Readsb sb"
apply (induct sb) 
apply simp
  subgoal for a sb
    by (case_tac a, auto)
done

lemma outstanding_is_Writesb_refs_conv: 
  "outstanding_refs is_Writesb sb =
   outstanding_refs is_non_volatile_Writesb sb  outstanding_refs is_volatile_Writesb sb"
apply (induct sb) 
apply simp
  subgoal for a sb
    by (case_tac a, auto)
done

lemma outstanding_is_Readsb_refs_conv: 
  "outstanding_refs is_Readsb sb =
   outstanding_refs is_non_volatile_Readsb sb  outstanding_refs is_volatile_Readsb sb"
apply (induct sb) 
apply simp
  subgoal for a sb
    by (case_tac a, auto)
done

lemma outstanding_not_volatile_Readsb_refs_conv: "outstanding_refs (Not  is_volatile_Readsb) sb =
       outstanding_refs is_Writesb sb  outstanding_refs is_non_volatile_Readsb sb"
apply (induct sb)
apply (clarsimp)
  subgoal for a sb
    by (case_tac a, auto)
done


lemmas misc_outstanding_refs_convs = outstanding_non_volatile_refs_conv outstanding_volatile_refs_conv
outstanding_is_Writesb_refs_conv outstanding_is_Readsb_refs_conv outstanding_not_volatile_Readsb_refs_conv

lemma no_outstanding_vol_write_takeWhile_append: "outstanding_refs is_volatile_Writesb sb = {}  
  takeWhile (Not  is_volatile_Writesb) (sb@xs) = sb@(takeWhile (Not  is_volatile_Writesb) xs)"
apply (induct sb)
apply (auto split: if_split_asm)
done

lemma outstanding_vol_write_takeWhile_append: "outstanding_refs is_volatile_Writesb sb  {}  
  takeWhile (Not  is_volatile_Writesb) (sb@xs) = (takeWhile (Not  is_volatile_Writesb) sb)"
apply (induct sb)
apply (auto split: if_split_asm)
done


lemma no_outstanding_vol_write_dropWhile_append: "outstanding_refs is_volatile_Writesb sb = {}  
  dropWhile (Not  is_volatile_Writesb) (sb@xs) = (dropWhile (Not  is_volatile_Writesb) xs)"
apply (induct sb)
apply (auto split: if_split_asm)
done

lemma outstanding_vol_write_dropWhile_append: "outstanding_refs is_volatile_Writesb sb  {}  
  dropWhile (Not  is_volatile_Writesb) (sb@xs) = (dropWhile (Not  is_volatile_Writesb) sb)@xs"
apply (induct sb)
apply (auto split: if_split_asm)
done

lemmas outstanding_vol_write_take_drop_appends =
no_outstanding_vol_write_takeWhile_append
outstanding_vol_write_takeWhile_append
no_outstanding_vol_write_dropWhile_append
outstanding_vol_write_dropWhile_append

lemma outstanding_refs_is_non_volatile_Writesb_takeWhile_conv:
  "outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sb) =
       outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sb)"
apply (induct sb)
apply  clarsimp
  subgoal for a sb
    by (case_tac a, auto)
done


lemma dropWhile_not_vol_write_empty:
  "outstanding_refs is_volatile_Writesb sb = {}  (dropWhile (Not  is_volatile_Writesb) sb) = []"
apply (induct sb)
apply (auto split: if_split_asm)
done

lemma takeWhile_not_vol_write_outstanding_refs:
  "outstanding_refs is_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sb) = {}"
apply (induct sb)
apply (auto split: if_split_asm)
done

lemma no_volatile_Writesbs_conv: "(outstanding_refs is_volatile_Writesb sb = {}) = 
       (r  set sb. (v' sop' a' A L R W. r  Writesb True a' sop' v' A L R W))"
  by (force simp add: outstanding_refs_conv is_volatile_Writesb_def split: memref.splits)

lemma no_volatile_Readsbs_conv: "(outstanding_refs is_volatile_Readsb sb = {}) = 
       (r  set sb. (v' t' a'. r  Readsb True a' t' v'))"
  by (force simp add: outstanding_refs_conv is_volatile_Readsb_def split: memref.splits)



inductive sb_memop_step :: "(instrs × tmps × 'p store_buffer × memory × 'dirty × 'owns × 'rels × 'shared )  
                  (instrs × tmps × 'p store_buffer × memory × 'dirty × 'owns × 'rels × 'shared )  bool" 
                    ("_ sb _" [60,60] 100)
where
  SBReadBuffered: 
  "buffered_val sb a = Some v
   
   (Read volatile a t # is,θ, sb, m,𝒟, 𝒪, , 𝒮) sb
          (is, θ (tv), sb, m,𝒟, 𝒪,, 𝒮)"

| SBReadUnbuffered: 
  "buffered_val sb a = None 
   
   (Read volatile a t # is, θ, sb, m,𝒟, 𝒪, , 𝒮) sb
          (is, θ (tm a), sb, m,𝒟, 𝒪, , 𝒮)"

| SBWriteNonVolatile:
  "(Write False a (D,f) A L R W#is, θ, sb, m,𝒟,𝒪, , 𝒮) sb
          (is, θ, sb@ [Writesb False a (D,f) (f θ) A L R W], m,𝒟, 𝒪, , 𝒮)"

| SBWriteVolatile:
   
   "(Write True a (D,f) A L R W# is, θ, sb, m,𝒟, 𝒪, , 𝒮) sb
         (is, θ, sb@[Writesb True a (D,f) (f θ) A L R W], m,𝒟, 𝒪, , 𝒮)"

| SBFence:
  "(Fence # is, θ, [], m,𝒟, 𝒪, , 𝒮) sb (is, θ, [], m,𝒟, 𝒪, , 𝒮)"

| SBRMWReadOnly:
  "¬ cond (θ(tm a))  
   (RMW a t (D,f) cond ret A L R W# is, θ, [], m,𝒟, 𝒪, , 𝒮) sb (is, θ(tm a),[], m,𝒟, 𝒪, , 𝒮)"

| SBRMWWrite:
  "cond (θ(tm a))  
   (RMW a t (D,f) cond ret A L R W# is, θ, [], m,𝒟, 𝒪, , 𝒮) sb
         (is, θ(tret (m a) (f(θ(tm a)))),[], m(a:= f(θ(tm a))),𝒟, 𝒪, , 𝒮)"

| SBGhost:
  "(Ghost A  L R W# is, θ, sb, m,𝒟, 𝒪, , 𝒮) sb
         (is, θ, sb, m,𝒟, 𝒪, , 𝒮)"


inductive sbh_memop_step :: "
                  (instrs × tmps × 'p store_buffer × memory × bool × owns × rels × shared ) 
                  (instrs × tmps × 'p store_buffer × memory × bool × owns × rels × shared )  bool" 
                    ("_ sbh _" [60,60] 100)
where
  SBHReadBuffered: 
  "buffered_val sb a = Some v
   
   (Read volatile a t # is, θ, sb, m, 𝒟, 𝒪, , 𝒮) sbh
          (is, θ (tv), sb@[Readsb volatile a t v], m, 𝒟, 𝒪, , 𝒮)"

| SBHReadUnbuffered: 
  "buffered_val sb a = None 
   
   (Read volatile a t # is, θ, sb, m, 𝒟, 𝒪, , 𝒮) sbh
          (is, θ (tm a), sb@[Readsb volatile a t (m a)], m, 𝒟, 𝒪, , 𝒮)"

| SBHWriteNonVolatile:
  "(Write False a (D,f) A L R W#is, θ, sb, m, 𝒟, 𝒪, , 𝒮) sbh
          (is, θ, sb@ [Writesb False a (D,f) (f θ) A L R W], m, 𝒟, 𝒪, , 𝒮)"

| SBHWriteVolatile:
  "(Write True a (D,f) A L R W# is, θ, sb, m, 𝒟, 𝒪, , 𝒮) sbh
         (is, θ, sb@[Writesb True a (D,f) (f θ) A L R W], m, True, 𝒪, , 𝒮)"

| SBHFence:
  "(Fence # is, θ, [], m, 𝒟, 𝒪, , 𝒮) sbh (is, θ, [], m, False, 𝒪, Map.empty, 𝒮)"

| SBHRMWReadOnly:
  "¬ cond (θ(tm a))  
   (RMW a t (D,f) cond ret A L R W# is, θ, [], m, 𝒟, 𝒪, , 𝒮) sbh (is, θ(tm a),[], m, False, 𝒪, Map.empty, 𝒮)"

| SBHRMWWrite:
  "cond (θ(tm a))  
   (RMW a t (D,f) cond ret A L R W# is, θ, [], m, 𝒟, 𝒪, , 𝒮) sbh
         (is, θ(tret (m a) (f(θ(tm a)))),[], m(a:= f(θ(tm a))), False, 𝒪  A - R,Map.empty, 𝒮W RA L)"

| SBHGhost:
  "(Ghost A L R W# is, θ, sb, m, 𝒟, 𝒪, , 𝒮) sbh
         (is, θ, sb@[Ghostsb A L R W], m, 𝒟, 𝒪, , 𝒮)"


interpretation direct:  memory_system direct_memop_step id_storebuffer_step .
interpretation sb: memory_system sb_memop_step store_buffer_step .
interpretation sbh: memory_system sbh_memop_step flush_step .

primrec non_volatile_owned_or_read_only:: "bool  shared  owns  'a memref list  bool"
where
"non_volatile_owned_or_read_only pending_write 𝒮 𝒪 [] = True"
| "non_volatile_owned_or_read_only pending_write 𝒮 𝒪 (x#xs) =
  (case x of
    Readsb volatile a t v  
     (¬volatile  pending_write  (a  𝒪  a  read_only 𝒮))  
      non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs
  | Writesb volatile a sop v A L R W  
     (if volatile then non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R) xs
      else a  𝒪  non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs)
  | Ghostsb A L R W  non_volatile_owned_or_read_only pending_write (𝒮W RA L) (𝒪  A - R) xs
  | _  non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs)"

primrec acquired :: "bool  'a memref list  addr set  addr set"
where
"acquired pending_write [] A = (if pending_write then A else {})"
| "acquired pending_write (x#xs) A =
  (case x of
     Writesb volatile _ _ _ A' L R W 
        (if volatile then acquired True xs (if pending_write then (A  A' - R) else (A' - R)) 
         else acquired pending_write xs A)
   | Ghostsb A' L R W  acquired pending_write xs (if pending_write then (A  A' - R) else A) 
   | _  acquired pending_write xs A)"

primrec share :: "'a memref list  shared  shared"
where
"share [] S = S"
| "share (x#xs) S =
  (case x of
     Writesb volatile _ _ _ A L R W  (if volatile then (share xs (SW RA L)) else share xs S)
   | Ghostsb A L R W  share xs (SW RA L)
   | _  share xs S)"

primrec acquired_reads :: "bool  'a memref list  addr set  addr set"
where
"acquired_reads pending_write [] A = {}"
| "acquired_reads pending_write (x#xs) A =
  (case x of
     Readsb volatile a t v  (if pending_write  ¬ volatile  a  A 
                             then insert a (acquired_reads pending_write xs A)
                             else acquired_reads pending_write xs A)
   | Writesb volatile _ _ _ A' L R W  
         (if volatile then acquired_reads True xs (if pending_write then (A  A' - R) else (A' - R)) 
          else acquired_reads pending_write xs A)
   | Ghostsb A' L R W  acquired_reads pending_write xs (A  A' - R)
   | _  acquired_reads pending_write xs A)"

lemma union_mono_aux: "A  B  A  C  B  C"
  by blast

lemma set_minus_mono_aux: "A  B  A - C  B - C"
  by blast

lemma acquired_mono: "A B pending_write. A  B  acquired pending_write xs A  acquired pending_write xs B"
apply (induct xs)
apply  simp
subgoal for a xs A B pending_write
apply (case_tac a ) 
apply    clarsimp 
         subgoal for volatile a1 D f v A' L R W x
           apply (drule_tac C=A' in union_mono_aux)
           apply (drule_tac C="R" in set_minus_mono_aux)
           apply blast
           done 
apply   clarsimp
apply  clarsimp
apply clarsimp
subgoal for A' L R W x
  apply (drule_tac C=A' in union_mono_aux)
  apply (drule_tac C="R" in set_minus_mono_aux)
  apply blast
  done
done
done


lemma acquired_mono_in: 
  assumes x_in: "x  acquired pending_write xs A" 
  assumes sub: "A  B" 
  shows "x  acquired pending_write xs B"
using acquired_mono [OF sub, of pending_write xs] x_in
by blast

lemma acquired_no_pending_write:"A B. acquired False xs A = acquired False xs B"
  by (induct xs) (auto split: memref.splits)

lemma acquired_no_pending_write_in:
  "x  acquired False xs A  x  acquired False xs B"
  apply (subst acquired_no_pending_write)
  apply auto
  done

lemma acquired_pending_write_mono_in: "A B. x  acquired False xs A  x  acquired True xs B"
apply (induct xs)
apply (auto split: memref.splits if_split_asm intro: acquired_mono_in)
done

lemma acquired_pending_write_mono: "acquired False xs A  acquired True xs B"
  by (auto intro: acquired_pending_write_mono_in)

lemma acquired_append: "A pending_write. acquired pending_write (xs@ys) A = 
 acquired (pending_write  outstanding_refs is_volatile_Writesb xs  {}) ys (acquired pending_write xs A)"
  apply (induct xs)
  apply (auto split: memref.splits intro: acquired_no_pending_write_in)
  done

lemma acquired_take_drop: 
  "acquired (pending_write  outstanding_refs is_volatile_Writesb (takeWhile P xs)  {}) 
      (dropWhile P xs) (acquired pending_write (takeWhile P xs) A) = 
   acquired pending_write xs A"
proof -
  have "acquired pending_write xs A = acquired pending_write ((takeWhile P xs)@(dropWhile P xs)) A"
    by simp
  also
  from acquired_append [where xs="(takeWhile P xs)" and ys="(dropWhile P xs)"]
  have " = acquired (pending_write  outstanding_refs is_volatile_Writesb (takeWhile P xs)  {}) 
      (dropWhile P xs) (acquired pending_write (takeWhile P xs) A)"
    by simp
  finally show ?thesis
    by simp
qed

lemma share_mono: "A B. dom A  dom B  dom (share xs A)  dom (share xs B)"
apply (induct xs)
apply  simp
subgoal for a xs A B
apply (case_tac a)
apply    (clarsimp iff del: domIff)
         subgoal for volatile a1 D f v A' L R W x
         apply (drule_tac C="R" and x="W" in augment_mono_aux)
         apply (drule_tac C="L" in restrict_mono_aux)
         apply blast
         done
apply   clarsimp
apply  clarsimp
apply (clarsimp iff del: domIff)
subgoal for A' L R W x
apply (drule_tac C="R" and x="W" in augment_mono_aux)
apply (drule_tac C="L" in restrict_mono_aux)
apply blast
done
done
done

lemma share_mono_in: 
  assumes x_in: "x  dom (share xs A)" 
  assumes sub: "dom A  dom B" 
  shows "x  dom (share xs B)"
using share_mono [OF sub, of xs] x_in
by blast

lemma acquired_reads_mono: 
  "A B pending_write. A  B  acquired_reads pending_write xs A  acquired_reads pending_write xs B"
apply (induct xs)
apply  simp
subgoal for a xs A B pending_write
apply (case_tac a)
apply    clarsimp
         subgoal for volatile a1 D f v A' L R W x
         apply (drule_tac C="A'" in union_mono_aux)
         apply (drule_tac C="R" in set_minus_mono_aux)
         apply blast
         done 
apply   clarsimp
apply   blast
apply  clarsimp
apply clarsimp
subgoal for A' L R W x
apply (drule_tac C="A'" in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
done
done

lemma acquired_reads_mono_in:
  assumes x_in: "x  acquired_reads pending_write xs A" 
  assumes sub: "A  B" 
  shows "x  acquired_reads pending_write xs B"
using acquired_reads_mono [OF sub, of pending_write xs] x_in
by blast

lemma acquired_reads_no_pending_write: "A B. acquired_reads False xs A = acquired_reads False xs B"
  by (induct xs) (auto split: memref.splits)

lemma acquired_reads_no_pending_write_in:
"x  acquired_reads False xs A  x  acquired_reads False xs B"
  apply (subst acquired_reads_no_pending_write)
  apply blast
  done

lemma acquired_reads_pending_write_mono:
  "A. acquired_reads False xs A  acquired_reads True xs A"
  by (induct xs) (auto split: memref.splits intro: acquired_reads_mono_in )

lemma acquired_reads_pending_write_mono_in: 
  assumes x_in: "x  acquired_reads False xs A" 
  shows "x  acquired_reads True xs A"
using acquired_reads_pending_write_mono [of xs A] x_in
by blast

lemma acquired_reads_append: "pending_write A. acquired_reads pending_write (xs@ys) A = 
  acquired_reads pending_write xs A  
  acquired_reads (pending_write  (outstanding_refs is_volatile_Writesb xs  {})) ys 
   (acquired pending_write xs A)"
proof (induct xs)
  case Nil thus ?case by (auto dest: acquired_reads_no_pending_write_in)
next
  case (Cons x xs)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      show ?thesis
	using Cons.hyps
	by (auto simp add: Writesb False)
    next
      case True
      show ?thesis
	using Cons.hyps
	by (auto simp add: Writesb True)
    qed
  next
    case (Readsb volatile a t v)
    show ?thesis
    proof (cases volatile)
      case False
      show ?thesis
	using Cons.hyps
	by (auto simp add: Readsb False)
    next
      case True
      show ?thesis
	using Cons.hyps
	by (auto simp add: Readsb True)
    qed
  next
    case Progsb
    with Cons.hyps show ?thesis by auto
  next
    case (Ghostsb A' L R W)
    have "(acquired False xs (A  A' -R )) = (acquired False xs A)"
      by (simp add: acquired_no_pending_write)
    with Cons.hyps show ?thesis by (auto simp add: Ghostsb)
  qed
qed

lemma in_acquired_reads_no_pending_write_outstanding_write: 
"A. a  acquired_reads False xs A  outstanding_refs (is_volatile_Writesb) xs  {}"
  apply (induct xs)
  apply simp
  apply (auto split: memref.splits)
  apply auto 
  done

lemma augment_read_only_mono: "read_only 𝒮  read_only 𝒮'  
  read_only (𝒮W R)  read_only (𝒮'W R)"
  by (auto simp add: augment_shared_def read_only_def)

lemma restrict_read_only_mono: "read_only 𝒮  read_only 𝒮'  
  read_only (𝒮A L)  read_only (𝒮'A L)"
  apply (clarsimp simp add: restrict_shared_def read_only_def split: option.splits if_split_asm)
  apply (rule conjI)
  apply  blast
  apply fastforce
  done


lemma share_read_only_mono: "𝒮 𝒮'. read_only 𝒮  read_only 𝒮' 
        read_only (share sb 𝒮)  read_only (share sb 𝒮')"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      with Cons Writesb show ?thesis by auto
    next
      case True
      note ‹read_only 𝒮  read_only 𝒮'
      from augment_read_only_mono [OF this]
      have "read_only (𝒮W R)  read_only (𝒮'W R)".
      from restrict_read_only_mono [OF this, of A L]
      have "read_only (𝒮W RA L)  read_only (𝒮'W RA L)".
      from Cons.hyps [OF this]
      show ?thesis
	by (clarsimp simp add: Writesb True)
    qed
  next
    case Readsb with Cons show ?thesis
      by auto
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W)
    note ‹read_only 𝒮  read_only 𝒮'
    from augment_read_only_mono [OF this]
    have "read_only (𝒮W R)  read_only (𝒮'W R)".
    from restrict_read_only_mono [OF this, of A L]
    have "read_only (𝒮W RA L)  read_only (𝒮'W RA L)".
   from Cons.hyps [OF this]
   show ?thesis
     by (clarsimp simp add: Ghostsb)
  qed
qed


(*
lemma read_only_share_takeWhile:
  "⋀𝒮. read_only (share (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒮)
       ⊆ read_only 𝒮"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case Writesb
    with Cons show ?thesis
      by (auto)
  next
    case Readsb
    with Cons show ?thesis
      by (auto)
  next
    case Progsb
    with Cons show ?thesis
      by (auto)
  next
    case (Ghostsb A L R W)
    note Cons.hyps [of "𝒮 ⊖A L"] 
    moreover
    have "read_only (𝒮 ⊖A L) ⊆ read_only 𝒮"
      by (auto simp add: in_read_only_restrict_conv)
    ultimately
    show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed

lemma read_only_share_takeWhile_in:
"a ∈ read_only (share (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒮) ⟹ a ∈  read_only 𝒮"
using read_only_share_takeWhile
by blast
*)
lemma non_volatile_owned_or_read_only_append: 
"𝒪 𝒮 pending_write. non_volatile_owned_or_read_only pending_write 𝒮 𝒪 (xs@ys)
         = (non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs  
            non_volatile_owned_or_read_only (pending_write  outstanding_refs is_volatile_Writesb xs  {}) 
             (share xs 𝒮) (acquired True xs 𝒪) ys)"
apply (induct xs)
apply (auto split: memref.splits)
done

lemma non_volatile_owned_or_read_only_mono:
"𝒪 𝒪' 𝒮 pending_write. 𝒪  𝒪'  non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs 
   non_volatile_owned_or_read_only pending_write 𝒮 𝒪' xs"
  apply (induct xs)
  apply  simp
  subgoal for a xs 𝒪 𝒪' 𝒮 pending_write
  apply (case_tac a)
  apply    (clarsimp split: if_split_asm)
           subgoal for volatile a1 D f v A L R W
           apply (drule_tac C="A" in union_mono_aux)
           apply (drule_tac C="R" in set_minus_mono_aux)
           apply blast
           done
  apply    fastforce
  apply   fastforce
  apply  fastforce
  apply clarsimp
  subgoal for A L R W
  apply (drule_tac C="A" in union_mono_aux)
  apply (drule_tac C="R" in set_minus_mono_aux)
  apply blast
  done
  done
  done

lemma non_volatile_owned_or_read_only_shared_mono:
"𝒮 𝒮' 𝒪 pending_write. 𝒮 s 𝒮'  non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs 
   non_volatile_owned_or_read_only pending_write 𝒮' 𝒪 xs"
  apply (induct xs)
  apply  simp
  subgoal for a xs 𝒮 𝒮' 𝒪 pending_write
  apply (case_tac a)
  apply    (clarsimp split: if_split_asm) 
           subgoal for volatile a1 D f v A L R W
           apply (frule_tac C="R" and x="W" in augment_mono_map)
           apply (drule_tac A="𝒮W R" and C="L" in restrict_mono_map)
           apply (fastforce dest: read_only_mono)
           done
  apply   (fastforce dest: read_only_mono shared_leD)
  apply  fastforce
  subgoal for A L R W
  apply (frule_tac C="R" and x="W" in augment_mono_map)
  apply (drule_tac A="𝒮W R" and C="L" in restrict_mono_map)
  apply (fastforce dest: read_only_mono)
  done
  done
  done

lemma non_volatile_owned_or_read_only_pending_write_antimono:
"𝒪 𝒮. non_volatile_owned_or_read_only True 𝒮 𝒪 xs 
   non_volatile_owned_or_read_only False 𝒮 𝒪 xs"
  by (induct xs) (auto split: memref.splits)

primrec all_acquired :: "'a memref list  addr set"
where 
  "all_acquired [] = {}"
|  "all_acquired (i#is) =
    (case i of
       Writesb volatile _ _ _ A L R W  (if volatile then A  all_acquired is else all_acquired is)
     | Ghostsb A L R W  A  all_acquired is
     | _  all_acquired is)"

lemma all_acquired_append: "all_acquired (xs@ys) = all_acquired xs  all_acquired ys"
  apply (induct xs)
  apply (auto split: memref.splits)
  done

lemma acquired_reads_all_acquired: "𝒪 pending_write.
  acquired_reads pending_write sb 𝒪  𝒪  all_acquired sb"
apply (induct sb)
apply  clarsimp
apply (auto split: memref.splits)
done

(*
lemma acquired_takeWhile_non_volatile_Writesb: 
  "⋀A. (acquired True (takeWhile (Not ∘ is_volatile_Writesb) sb) A) = 
         A ∪ all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sb)"
*)
lemma acquired_takeWhile_non_volatile_Writesb: 
  "A. (acquired True (takeWhile (Not  is_volatile_Writesb) sb) A)  
         A  all_acquired (takeWhile (Not  is_volatile_Writesb) sb)"
apply (induct sb)
apply  clarsimp 
subgoal for a sb A
apply (case_tac a)
apply auto
done
done

lemma acquired_False_takeWhile_non_volatile_Writesb:
  "acquired False (takeWhile (Not  is_volatile_Writesb) sb) A = {}"
  apply (induct sb)
   apply simp
  subgoal for a sb
    by (case_tac a) auto
  done  

lemma outstanding_refs_takeWhile_opposite: "outstanding_refs P (takeWhile (Not  P) xs) = {}"   
apply (induct xs)
apply auto
done


lemma no_outstanding_volatile_Writesb_acquired:
  "outstanding_refs is_volatile_Writesb sb = {}  acquired False sb A = {}"
  apply (induct sb)
   apply simp
  subgoal for a sb
    by (case_tac a) auto
  done

lemma acquired_all_acquired:"pending_write A. acquired pending_write xs A  A  all_acquired xs"
  apply (induct xs)
  apply (auto split: memref.splits)
  done

lemma acquired_all_acquired_in: "x  acquired pending_write xs A  x  A  all_acquired xs"
  using acquired_all_acquired
  by blast



primrec sharing_consistent:: "shared  owns  'a memref list   bool"
where
"sharing_consistent 𝒮 𝒪 [] = True"
| "sharing_consistent 𝒮 𝒪 (r#rs) =
   (case r of
     Writesb volatile _ _ _ A L R W  
      (if volatile then A  dom 𝒮  𝒪  L  A  A  R = {}  R  𝒪  
                       sharing_consistent (𝒮W RA L) (𝒪  A - R) rs
      else sharing_consistent 𝒮 𝒪 rs)  
   | Ghostsb A L R W   A  dom 𝒮  𝒪  L  A  A  R = {}  R  𝒪  
        sharing_consistent (𝒮W RA L) (𝒪  A - R) rs
   | _  sharing_consistent 𝒮 𝒪 rs)"

lemma sharing_consistent_all_acquired:
  "𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb  all_acquired sb  dom 𝒮  𝒪"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      with Cons Writesb show ?thesis by auto
    next
      case True
      from Cons.hyps [where 𝒮="(𝒮W RA L)" and 𝒪="(𝒪  A - R)"] Cons.prems
      show ?thesis
	by (auto simp add: Writesb True)
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)       
    with Cons.hyps [where 𝒮="(𝒮W RA L)" and 𝒪="(𝒪  A - R)"] Cons.prems show ?thesis by auto
  qed
qed

lemma sharing_consistent_append:
"𝒮 𝒪. sharing_consistent 𝒮 𝒪 (xs@ys) =
     (sharing_consistent 𝒮 𝒪 xs  
      sharing_consistent (share xs 𝒮) (acquired True xs 𝒪) ys)"
apply (induct xs)
apply (auto split: memref.splits)
done

primrec read_only_reads :: "owns  'a memref list  addr set"
where
"read_only_reads 𝒪 [] = {}"
| "read_only_reads 𝒪 (x#xs) =
  (case x of
     Readsb volatile a t v  (if ¬ volatile  a  𝒪 
                             then insert a (read_only_reads 𝒪 xs)
                             else read_only_reads 𝒪 xs)
   | Writesb volatile _ _ _ A L R W  
         (if volatile then read_only_reads (𝒪  A - R) xs  
          else read_only_reads 𝒪 xs )
   | Ghostsb A L R W  read_only_reads (𝒪  A - R) xs 
   | _  read_only_reads 𝒪 xs)"

lemma read_only_reads_append:
"𝒪. read_only_reads 𝒪 (xs@ys) = 
  read_only_reads 𝒪 xs  read_only_reads (acquired True xs 𝒪) ys"
  apply (induct xs)
   apply simp
  subgoal for a xs 𝒪
    by (case_tac a) auto
  done

lemma read_only_reads_antimono:
  "𝒪 𝒪'. 
  𝒪  𝒪'  read_only_reads 𝒪' sb  read_only_reads 𝒪 sb"
  apply (induct sb)
  apply  simp
  subgoal for a sb 𝒪 𝒪'
  apply (case_tac a)
  apply    (clarsimp split: if_split_asm)
           subgoal for volatile a1 D f v A L R W
           apply (drule_tac C="A" in union_mono_aux)
           apply (drule_tac C="R" in set_minus_mono_aux)
           apply blast
           done 
  apply   auto
  subgoal for A L R W x
  apply (drule_tac C="A" in union_mono_aux)
  apply (drule_tac C="R" in set_minus_mono_aux)
  apply blast
  done
  done
  done

primrec non_volatile_writes_unshared:: "shared  'a memref list  bool"
where
"non_volatile_writes_unshared 𝒮 [] = True"
| "non_volatile_writes_unshared 𝒮 (x#xs) =
  (case x of
    Writesb volatile a sop v A L R W  (if volatile then non_volatile_writes_unshared (𝒮W RA L) xs
                                     else a  dom 𝒮  non_volatile_writes_unshared 𝒮 xs)
  | Ghostsb A L R W   non_volatile_writes_unshared (𝒮W RA L) xs
  | _  non_volatile_writes_unshared 𝒮 xs)"


lemma non_volatile_writes_unshared_append: 
"𝒮. non_volatile_writes_unshared 𝒮 (xs@ys)
         = (non_volatile_writes_unshared 𝒮 xs  non_volatile_writes_unshared (share xs 𝒮) ys)"
apply (induct xs)
apply (auto split: memref.splits)
done

lemma non_volatile_writes_unshared_antimono:
"𝒮 𝒮'. dom 𝒮  dom 𝒮'  non_volatile_writes_unshared 𝒮' xs 
   non_volatile_writes_unshared 𝒮 xs"
  apply (induct xs)
  apply  simp
  subgoal for a xs 𝒮 𝒮'
  apply (case_tac a)
  apply     (clarsimp split: if_split_asm)
            subgoal for volatile a1 D f v A L R W
            apply (drule_tac C="R" in augment_mono_aux)
            apply (drule_tac C="L" in restrict_mono_aux)
            apply blast
            done
  apply    fastforce
  apply   fastforce
  apply  fastforce
  apply (clarsimp split: if_split_asm)
  subgoal for A L R W
  apply (drule_tac C="R" in augment_mono_aux)
  apply (drule_tac C="L" in restrict_mono_aux)
  apply blast
  done
  done
  done 

primrec  no_write_to_read_only_memory:: "shared  'a memref list  bool"
where
"no_write_to_read_only_memory 𝒮 [] = True"
| "no_write_to_read_only_memory 𝒮 (x#xs) =
  (case x of
    Writesb volatile a sop v A L R W  a  read_only 𝒮 
                                      (if volatile then no_write_to_read_only_memory (𝒮W RA L) xs
                                       else no_write_to_read_only_memory 𝒮 xs)
  | Ghostsb A L R W   no_write_to_read_only_memory (𝒮W RA L) xs
  | _  no_write_to_read_only_memory 𝒮 xs)"

lemma no_write_to_read_only_memory_append: 
"𝒮. no_write_to_read_only_memory 𝒮 (xs@ys)
         = (no_write_to_read_only_memory 𝒮 xs  no_write_to_read_only_memory (share xs 𝒮) ys)"
apply (induct xs)
apply  simp
subgoal for a xs 𝒮
  by (case_tac a) auto
done

lemma no_write_to_read_only_memory_antimono:
"𝒮 𝒮'. 𝒮 s 𝒮'  no_write_to_read_only_memory 𝒮' xs 
   no_write_to_read_only_memory 𝒮 xs"
  apply (induct xs)
  apply  simp
  subgoal for a xs 𝒮 𝒮' 
  apply (case_tac a)
  apply    (clarsimp split: if_split_asm) 
             subgoal for volatile a1 D f v A L R W 
             apply (frule_tac C="R" and x="W" in augment_mono_map)
             apply (drule_tac A="𝒮W R" and C="L" and x="A" in restrict_mono_map)
             apply (fastforce dest: read_only_mono shared_leD)
             done
  apply    (fastforce dest: read_only_mono shared_leD)
  apply   fastforce
  apply  fastforce
  apply (clarsimp)
  subgoal for A L R W
  apply (frule_tac C="R" and x="W" in augment_mono_map)
  apply (drule_tac A="𝒮W R" and C="L" and x="A" in restrict_mono_map)
  apply (fastforce dest: read_only_mono shared_leD)
  done
  done
  done

locale outstanding_non_volatile_refs_owned_or_read_only =
fixes 𝒮::shared
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes outstanding_non_volatile_refs_owned_or_read_only:
  "i is 𝒪  𝒟 θ sb p. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)  
   
   non_volatile_owned_or_read_only False 𝒮 𝒪 sb"

locale outstanding_volatile_writes_unowned_by_others =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes outstanding_volatile_writes_unowned_by_others: 
  "i pi isi 𝒪i i 𝒟i θi sbi j pj isj 𝒪j j 𝒟j θj sbj. 
   i < length ts; j < length ts; ij;
    ts!i = (pi,isi,θi,sbi,𝒟i,𝒪i,i); ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)
   
   
    (𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sbi = {}"


locale read_only_reads_unowned =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes read_only_reads_unowned: 
  "i pi isi 𝒪i i 𝒟i θi sbi j pj isj 𝒪j j 𝒟j θj sbj. 
   i < length ts; j < length ts; ij;
    ts!i = (pi,isi,θi,sbi,𝒟i,𝒪i,i); ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)
   
   
    (𝒪j  all_acquired sbj)  
     read_only_reads (acquired True 
                          (takeWhile (Not  is_volatile_Writesb) sbi) 𝒪i) 
                          (dropWhile (Not  is_volatile_Writesb) sbi) = {}"

locale ownership_distinct =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes ownership_distinct:
   "i j pi isi 𝒪i i 𝒟i θi sbi pj isj 𝒪j j 𝒟j θj sbj. 
      i < length ts; j < length ts; i  j; 
    ts!i = (pi,isi,θi,sbi,𝒟i,𝒪i,i); ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)
        (𝒪i  all_acquired sbi)  (𝒪j  all_acquired sbj) = {}"


locale valid_ownership = 
  outstanding_non_volatile_refs_owned_or_read_only + 
  outstanding_volatile_writes_unowned_by_others + 
  read_only_reads_unowned +
  ownership_distinct

locale outstanding_non_volatile_writes_unshared =
fixes 𝒮::shared and ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes outstanding_non_volatile_writes_unshared:
  "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)  
   
   non_volatile_writes_unshared 𝒮 sb"


locale sharing_consis =
fixes 𝒮::shared and ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes sharing_consis:
  "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)  
   
   sharing_consistent 𝒮 𝒪 sb"




locale no_outstanding_write_to_read_only_memory =
fixes 𝒮::shared and ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes no_outstanding_write_to_read_only_memory:
  "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)  
   
   no_write_to_read_only_memory 𝒮 sb"


locale valid_sharing = 
  outstanding_non_volatile_writes_unshared +
  sharing_consis +
  read_only_unowned +
  unowned_shared +
  no_outstanding_write_to_read_only_memory

locale valid_ownership_and_sharing = valid_ownership +
  outstanding_non_volatile_writes_unshared +
  sharing_consis +
  no_outstanding_write_to_read_only_memory


lemma (in read_only_reads_unowned)
  read_only_reads_unowned_nth_update:
 "i p is 𝒪  𝒟  θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,); 
     read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb') 𝒪') 
       (dropWhile (Not  is_volatile_Writesb) sb')  read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪) 
       (dropWhile (Not  is_volatile_Writesb) sb);
     𝒪'  all_acquired sb'  𝒪  all_acquired sb  
     read_only_reads_unowned (ts[i := (p',is',θ',sb',𝒟',𝒪',ℛ')])"
  apply (unfold_locales)
  apply (clarsimp simp add: nth_list_update split: if_split_asm)
  apply   (fastforce dest: read_only_reads_unowned)+
  done

 
lemma outstanding_non_volatile_refs_owned_or_read_only_tl: 
  "outstanding_non_volatile_refs_owned_or_read_only 𝒮 (t#ts)  outstanding_non_volatile_refs_owned_or_read_only 𝒮 ts"
  by (force simp add: outstanding_non_volatile_refs_owned_or_read_only_def)

lemma outstanding_volatile_writes_unowned_by_others_tl: 
  "outstanding_volatile_writes_unowned_by_others (t#ts)  outstanding_volatile_writes_unowned_by_others ts"
  apply (clarsimp simp add: outstanding_volatile_writes_unowned_by_others_def)
  apply fastforce
  done


lemma read_only_reads_unowned_tl: 
  "read_only_reads_unowned  (t # ts) 
    read_only_reads_unowned  (ts)"
  apply (clarsimp simp add: read_only_reads_unowned_def)
  apply fastforce
  done



lemma ownership_distinct_tl:
  assumes dist: "ownership_distinct (t#ts)" 
  shows "ownership_distinct ts"
proof -
  from dist
  interpret ownership_distinct "t#ts" .
  
  show ?thesis
  proof (rule ownership_distinct.intro)
    fix i j p "is" 𝒪  𝒟 xs sb p' is' 𝒪' ℛ' 𝒟' xs' sb'
    assume i_bound: "i < length ts" 
      and j_bound: "j < length ts" 
      and neq: "i  j" 
      and ith: "ts ! i = (p,is,xs,sb,𝒟,𝒪,)"
      and jth: "ts ! j = (p',is', xs', sb',𝒟', 𝒪',ℛ')"
    from i_bound j_bound neq ith jth
    show "(𝒪  all_acquired sb)  (𝒪'  all_acquired sb') = {}"
      by - (rule ownership_distinct [of "Suc i" "Suc j"],auto)
  qed
qed

lemma valid_ownership_tl: "valid_ownership 𝒮 (t#ts)  valid_ownership 𝒮 ts"
  by (auto simp add: valid_ownership_def 
    intro: outstanding_volatile_writes_unowned_by_others_tl 
    outstanding_non_volatile_refs_owned_or_read_only_tl ownership_distinct_tl
    read_only_reads_unowned_tl)


lemma sharing_consistent_takeWhile: 
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  shows "sharing_consistent 𝒮 𝒪 (takeWhile P sb)"
proof -
  from consis have "sharing_consistent 𝒮 𝒪 (takeWhile P sb @ dropWhile P sb)"
    by simp
  with sharing_consistent_append [of _ _ "takeWhile P sb" "dropWhile P sb"] 
  show ?thesis
    by simp
qed
    
lemma sharing_consis_tl: "sharing_consis 𝒮 (t#ts)  sharing_consis 𝒮 ts"
  by (auto simp add: sharing_consis_def)

lemma sharing_consis_Cons: 
  "sharing_consis 𝒮 ts; sharing_consistent 𝒮 𝒪 sb
    sharing_consis 𝒮 ((p,is,θ,sb,𝒟,𝒪,)#ts)"
  apply (clarsimp simp add: sharing_consis_def)
  subgoal for i pa isa 𝒪' ℛ' 𝒟' θ' sba
    by (case_tac i) auto
  done

lemma outstanding_non_volatile_writes_unshared_tl:
  "outstanding_non_volatile_writes_unshared 𝒮 (t#ts)  
  outstanding_non_volatile_writes_unshared 𝒮 ts"
  by (auto simp add: outstanding_non_volatile_writes_unshared_def)

lemma no_outstanding_write_to_read_only_memory_tl:
  "no_outstanding_write_to_read_only_memory 𝒮 (t#ts) 
  no_outstanding_write_to_read_only_memory 𝒮 ts"
  by (auto simp add: no_outstanding_write_to_read_only_memory_def)

lemma valid_ownership_and_sharing_tl: 
  "valid_ownership_and_sharing 𝒮 (t#ts)  valid_ownership_and_sharing 𝒮 ts"
  apply (clarsimp simp add: valid_ownership_and_sharing_def)
  apply (auto intro: valid_ownership_tl
    outstanding_non_volatile_writes_unshared_tl
    no_outstanding_write_to_read_only_memory_tl
    sharing_consis_tl)
  done


lemma non_volatile_owned_or_read_only_outstanding_non_volatile_writes: 
  "𝒪 𝒮 pending_write. non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb
   
  outstanding_refs is_non_volatile_Writesb sb  𝒪  all_acquired sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      from Cons.hyps [of True "(𝒮W RA L)" "(𝒪  A - R)"] Cons.prems
      show ?thesis
	by (auto simp add: Writesb True)
    next
      case False with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis
      by auto
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W)
    from Cons.hyps [of pending_write "(𝒮W RA L)" "(𝒪  A - R)"] Cons.prems
    show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed

lemma (in outstanding_non_volatile_refs_owned_or_read_only) outstanding_non_volatile_writes_owned:
  assumes i_bound: "i < length ts" 
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
  shows "outstanding_refs is_non_volatile_Writesb sb  𝒪  all_acquired sb"
using non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts_i]]
by blast







lemma non_volatile_reads_acquired_or_read_only: 
  "𝒪 𝒮. non_volatile_owned_or_read_only True 𝒮 𝒪 sb; sharing_consistent 𝒮 𝒪 sb
   
  outstanding_refs is_non_volatile_Readsb sb  𝒪  all_acquired sb  read_only 𝒮"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True

      from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R)  sb" and 
	A_shared_onws: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True )

      from Cons.hyps [OF non_vol consis']
      have hyp: "outstanding_refs is_non_volatile_Readsb sb
                  𝒪  A - R  all_acquired sb  read_only (𝒮W RA L)".
      with R_owns A_R L_A
      show ?thesis
	apply (clarsimp simp add: Writesb True )
	apply (drule (1) rev_subsetD)
	apply (auto simp add: in_read_only_convs split: if_split_asm)
	done
    next
      case False with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis
      by auto
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W) 
    from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R)  sb" and 
      A_shared_onws: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb )

    from Cons.hyps [OF non_vol consis']
    have hyp: "outstanding_refs is_non_volatile_Readsb sb
       𝒪  A - R  all_acquired sb  read_only (𝒮W RA L)".
    with R_owns A_R L_A
    show ?thesis
      apply (clarsimp simp add: Ghostsb )
      apply (drule (1) rev_subsetD)
      apply (auto simp add: in_read_only_convs split: if_split_asm)
      done
  qed
qed


lemma non_volatile_reads_acquired_or_read_only_reads: 
  "𝒪 𝒮 pending_write. non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb
   
  outstanding_refs is_non_volatile_Readsb sb  𝒪  all_acquired sb  read_only_reads 𝒪 sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True

      from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R)  sb" 
	by (clarsimp simp add: Writesb True )

      from Cons.hyps [OF non_vol ]
      have hyp: "outstanding_refs is_non_volatile_Readsb sb
                  𝒪  A - R  all_acquired sb  read_only_reads (𝒪  A - R) sb".
      then 
      show ?thesis
	by (auto simp add: Writesb True )
    next
      case False with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis
      by auto
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W) 
    from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only pending_write (𝒮W RA L) (𝒪  A - R)  sb" 
      by (clarsimp simp add: Ghostsb )

    from Cons.hyps [OF non_vol ]
    have hyp: "outstanding_refs is_non_volatile_Readsb sb
                  𝒪  A - R  all_acquired sb  read_only_reads (𝒪  A - R) sb".
    then 
    show ?thesis
      by (auto simp add: Ghostsb )
  qed
qed




lemma non_volatile_owned_or_read_only_outstanding_refs: 
  "𝒪 𝒮 pending_write. non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb
   
  outstanding_refs (Not  is_volatile) sb  𝒪  all_acquired sb  read_only_reads 𝒪 sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      from Cons.hyps [of True "(𝒮W RA L)" "(𝒪  A - R)"] Cons.prems
      show ?thesis
	by (auto simp add: Writesb True)
    next
      case False with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis
      by auto
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W) 
    from Cons.hyps [of pending_write "(𝒮W RA L)" "(𝒪  A - R)"] Cons.prems
    show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed



lemma no_unacquired_write_to_read_only:
"𝒮 𝒪. no_write_to_read_only_memory 𝒮 sb;sharing_consistent 𝒮 𝒪 sb;
 a  read_only 𝒮; a  (𝒪  all_acquired sb) 
        a  outstanding_refs is_Writesb sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True

      from Cons.prems obtain no_wrt: "no_write_to_read_only_memory (𝒮W RA L) sb" and 
	A_shared_onws: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and 
	a_ro: "a  read_only 𝒮" and
	a_A: "a  A" and a_all_acq: "a  all_acquired sb" and a_owns: "a  𝒪" and 
	a'_notin: "a'  read_only 𝒮" 
	by ( simp add: Writesb True )
      
      from a'_notin a_ro have neq_a_a': "aa'"
	by blast

      from a_A a_all_acq a_owns
      have a_notin': "a  𝒪  A - R  all_acquired sb"
	by auto
      from a_ro L_A a_A R_owns a_owns
      have "a  read_only (𝒮W RA L)"
	by (auto simp add: in_read_only_convs split: if_split_asm)

      from Cons.hyps [OF no_wrt consis' this a_notin']
      have "a  outstanding_refs is_Writesb sb".
      with neq_a_a'
      show ?thesis
	by (clarsimp simp add: Writesb True)
    next
      case False with Cons
      show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case Readsb with Cons
    show ?thesis
      by (auto)
  next
    case Progsb with Cons
    show ?thesis
      by (auto)
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain no_wrt: "no_write_to_read_only_memory (𝒮W RA L) sb" and 
	A_shared_onws: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and
	a_ro: "a  read_only 𝒮" and
	a_A: "a  A" and a_all_acq: "a  all_acquired sb" and a_owns: "a  𝒪" 
	by ( simp add: Ghostsb )
      
      
      from a_A a_all_acq a_owns
      have a_notin': "a  𝒪  A - R  all_acquired sb"
	by auto
      from a_ro L_A a_A R_owns a_owns
      have "a  read_only (𝒮W RA L)"
	by (auto simp add: in_read_only_convs split: if_split_asm)

      from Cons.hyps [OF no_wrt consis' this a_notin']
      have "a  outstanding_refs is_Writesb sb".
      then
      show ?thesis
	by (clarsimp simp add: Ghostsb)
  qed
qed

lemma read_only_reads_read_only: 
  "𝒮 𝒪. non_volatile_owned_or_read_only True 𝒮 𝒪 sb;
  sharing_consistent 𝒮 𝒪 sb
  
  read_only_reads 𝒪 sb  𝒪  all_acquired sb  read_only 𝒮"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True

      from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R)  sb" and 
	A_shared_onws: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True )

      from Cons.hyps [OF non_vol consis']
      have hyp: "read_only_reads (𝒪  A - R) sb
                  𝒪  A - R  all_acquired sb  read_only (𝒮W RA L)".

      {
	fix a'
	assume a'_in: "a'  read_only_reads (𝒪  A - R) sb"
	assume a'_unowned: "a'  𝒪"
	assume a'_unacq: "a'  all_acquired sb"
	assume a'_A: "a'  A"
	have "a'  read_only 𝒮"
	proof -
	  from a'_in hyp a'_unowned a'_unacq a'_A 
	  have "a'  read_only (𝒮W RA L)"
	    by auto
	  
	  with L_A R_owns a'_unowned
	  show ?thesis
	    by (auto simp add: in_read_only_convs split:if_split_asm)
	qed
      }
	
      then
	  
      show ?thesis
	apply (clarsimp simp add: Writesb True simp del: o_apply)
	apply force
	done
    next
      case False with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis
      by auto
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W) 
    from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R)  sb" and 
      A_shared_onws: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb )

    from Cons.hyps [OF non_vol consis']
    have hyp: "read_only_reads (𝒪  A - R) sb
                  𝒪  A - R  all_acquired sb  read_only (𝒮W RA L)".

    {
      fix a'
      assume a'_in: "a'  read_only_reads (𝒪  A - R) sb"
      assume a'_unowned: "a'  𝒪"
      assume a'_unacq: "a'  all_acquired sb"
      assume a'_A: "a'  A"
      have "a'  read_only 𝒮"
      proof -
	from a'_in hyp a'_unowned a'_unacq a'_A 
	have "a'  read_only (𝒮W RA L)"
	  by auto
	  
	with L_A R_owns a'_unowned
	show ?thesis
	  by (auto simp add: in_read_only_convs split:if_split_asm)
        qed
    }
	
    then
	  
    show ?thesis
      apply (clarsimp simp add: Ghostsb simp del: o_apply)
      apply force
      done
    
  qed
qed

lemma no_unacquired_write_to_read_only_reads:
"𝒮 𝒪 . no_write_to_read_only_memory 𝒮 sb;
non_volatile_owned_or_read_only True 𝒮 𝒪 sb; sharing_consistent 𝒮 𝒪 sb;
 a  read_only_reads 𝒪 sb; a  (𝒪  all_acquired sb) 
        a  outstanding_refs is_Writesb sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True

      from Cons.prems obtain no_wrt: "no_write_to_read_only_memory (𝒮W RA L) sb" and 
	non_vol: "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R)  sb" and 
	A_shared_onws: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and 
	a_ro: "a  read_only_reads (𝒪  A - R) sb" and
	a_A: "a  A" and a_all_acq: "a  all_acquired sb" and a_owns: "a  𝒪" and 
	a'_notin: "a'  read_only 𝒮" 
	by ( simp add: Writesb True )

      from read_only_reads_read_only [OF non_vol consis' ] a_ro a_owns a_all_acq a_A
      have "a  read_only (𝒮W RA L)" 
	by auto
      with a'_notin R_owns a_owns have neq_a_a': "aa'"
	by (auto simp add:  in_read_only_convs split: if_split_asm)
      

      from a_A a_all_acq a_owns
      have a_notin': "a  𝒪  A - R  all_acquired sb"
	by auto

      from Cons.hyps [OF no_wrt non_vol consis' a_ro a_notin'] 
      have "a  outstanding_refs is_Writesb sb".
      then 
      show ?thesis
	using neq_a_a'
	by (auto simp add: Writesb True)
    next
      case False with Cons
      show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case (Readsb volatile a' t v) 
    show ?thesis
    proof (cases volatile)
      case True
      with Cons show ?thesis
	by  (auto simp add: Readsb)
    next
      case False
      note non_volatile = this
      from Cons.prems obtain no_wrt': "no_write_to_read_only_memory 𝒮 sb" and 
	consis':"sharing_consistent 𝒮 𝒪 sb" and
	a_in: "a  (if a'  𝒪 then insert a' (read_only_reads 𝒪 sb)
                 else read_only_reads 𝒪 sb)" and
	a'_owns_shared: "a'  𝒪  a'  read_only 𝒮" and 
	non_vol': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and
        a_owns: "a  𝒪  all_acquired sb"
	by (clarsimp simp add: Readsb False)

      show ?thesis
      proof (cases "a'  𝒪")
	case True
	with a_in have "a  read_only_reads 𝒪 sb"
	  by auto
	from Cons.hyps [OF no_wrt' non_vol' consis' this a_owns]
	show ?thesis
	  by (clarsimp simp add: Readsb)
      next
	case False
	note a'_unowned = this
	with a_in have a_in': "a  insert a' (read_only_reads 𝒪 sb)" by auto
	from a'_owns_shared False have a'_read_only: "a'  read_only 𝒮" by auto
	show ?thesis
	proof (cases "a=a'")
	  case False
	  with a_in' have "a  (read_only_reads 𝒪 sb)" by auto
	  from Cons.hyps [OF no_wrt' non_vol' consis' this a_owns]
	  show ?thesis
	    by (simp add: Readsb)
	next
	  case True
	  from no_unacquired_write_to_read_only [OF no_wrt' consis' a'_read_only] a_owns True
	  
	  have "a'  outstanding_refs is_Writesb sb"
	    by auto
	  then show ?thesis
	    by (simp add: Readsb True)
	qed
      qed
    qed
  next
    case Progsb with Cons
    show ?thesis
      by (auto)
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain no_wrt: "no_write_to_read_only_memory (𝒮W RA L) sb" and 
      non_vol: "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R)  sb" and 
      A_shared_onws: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and 
      a_ro: "a  read_only_reads (𝒪  A - R) sb" and
      a_A: "a  A" and a_all_acq: "a  all_acquired sb" and a_owns: "a  𝒪" 
      by ( simp add: Ghostsb )

    from read_only_reads_read_only [OF non_vol consis' ] a_ro a_owns a_all_acq a_A
    have "a  read_only (𝒮W RA L)" 
      by auto
      

    from a_A a_all_acq a_owns
    have a_notin': "a  𝒪  A - R  all_acquired sb"
      by auto

    from Cons.hyps [OF no_wrt non_vol consis' a_ro a_notin'] 
    have "a  outstanding_refs is_Writesb sb".
    then 
    show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed


lemma no_unacquired_write_to_read_only'':
  assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  shows "read_only 𝒮  outstanding_refs is_Writesb sb  𝒪  all_acquired sb"
using no_unacquired_write_to_read_only [OF no_wrt consis]
by auto

lemma no_unacquired_volatile_write_to_read_only:
  assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  shows "read_only 𝒮  outstanding_refs is_volatile_Writesb sb  𝒪  all_acquired sb"
proof -
  have "outstanding_refs is_volatile_Writesb sb  outstanding_refs is_Writesb sb"
    apply (rule outstanding_refs_mono_pred)
    apply (auto simp add: is_volatile_Writesb_def split: memref.splits)
    done
  with no_unacquired_write_to_read_only'' [OF no_wrt consis]
  show ?thesis by blast
qed

lemma no_unacquired_non_volatile_write_to_read_only_reads:
  assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  shows "read_only 𝒮  outstanding_refs is_non_volatile_Writesb sb  𝒪  all_acquired sb"
proof -
  from outstanding_refs_subsets 
  have "outstanding_refs is_non_volatile_Writesb sb  outstanding_refs is_Writesb sb" by - assumption
  with no_unacquired_write_to_read_only'' [OF no_wrt consis]
  show ?thesis by blast
qed


lemma no_unacquired_write_to_read_only_reads':
  assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
  assumes non_vol: "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  shows "read_only_reads 𝒪 sb  outstanding_refs is_Writesb sb  𝒪  all_acquired sb"
using no_unacquired_write_to_read_only_reads [OF no_wrt non_vol consis]
by auto

lemma no_unacquired_volatile_write_to_read_only_reads:
  assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
  assumes non_vol: "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  shows "read_only_reads 𝒪 sb  outstanding_refs is_volatile_Writesb sb  𝒪  all_acquired sb"
proof -
  have "outstanding_refs is_volatile_Writesb sb  outstanding_refs is_Writesb sb"
    apply (rule outstanding_refs_mono_pred)
    apply (auto simp add: is_volatile_Writesb_def split: memref.splits)
    done
  with no_unacquired_write_to_read_only_reads [OF no_wrt non_vol consis]
  show ?thesis by blast
qed

lemma no_unacquired_non_volatile_write_to_read_only:
  assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
  assumes non_vol: "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  shows "read_only_reads 𝒪 sb  outstanding_refs is_non_volatile_Writesb sb  𝒪  all_acquired sb"
proof -
  from outstanding_refs_subsets 
  have "outstanding_refs is_non_volatile_Writesb sb  outstanding_refs is_Writesb sb" by - assumption
  with no_unacquired_write_to_read_only_reads [OF no_wrt non_vol consis]
  show ?thesis by blast
qed



lemma set_dropWhileD: "x  set (dropWhile P xs)  x  set xs"
  by (induct xs) (auto split: if_split_asm)

lemma outstanding_refs_takeWhileD:
  "x  outstanding_refs P (takeWhile P' sb)  x  outstanding_refs P sb"
  using outstanding_refs_takeWhile
  by blast

lemma outstanding_refs_dropWhileD:
  "x  outstanding_refs P (dropWhile P' sb)  x  outstanding_refs P sb"
  by (auto dest: set_dropWhileD simp add: outstanding_refs_conv)



lemma dropWhile_ConsD: "dropWhile P xs = y#ys  ¬ P y"
  by (simp add: dropWhile_eq_Cons_conv)


lemma non_volatile_owned_or_read_only_drop:
  "non_volatile_owned_or_read_only False 𝒮 𝒪 sb
   non_volatile_owned_or_read_only True 
      (share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮) 
      (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪) 
      (dropWhile (Not  is_volatile_Writesb) sb)"
using non_volatile_owned_or_read_only_append [of False 𝒮 𝒪 "(takeWhile (Not  is_volatile_Writesb) sb)" 
  "(dropWhile (Not  is_volatile_Writesb) sb)"]
apply (cases "outstanding_refs is_volatile_Writesb sb = {}")
apply  (clarsimp simp add: outstanding_vol_write_take_drop_appends 
  takeWhile_not_vol_write_outstanding_refs dropWhile_not_vol_write_empty)
apply(clarsimp simp add: outstanding_vol_write_take_drop_appends 
  takeWhile_not_vol_write_outstanding_refs dropWhile_not_vol_write_empty )
apply (case_tac "(dropWhile (Not  is_volatile_Writesb) sb)")
apply  (fastforce simp add: outstanding_refs_conv)
apply (frule dropWhile_ConsD)
apply (clarsimp split: memref.splits)
done


lemma  read_only_share: "𝒮 𝒪. 
  sharing_consistent 𝒮 𝒪 sb  
        read_only (share sb 𝒮)  read_only 𝒮  𝒪  all_acquired sb"
proof (induct sb)
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      from Cons.prems obtain 
	A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True )
      from Cons.hyps [OF  consis']
      have "read_only (share sb (𝒮W RA L))
               read_only (𝒮W RA L)  (𝒪  A - R)  all_acquired sb"
        by auto
      also from A_shared_owns L_A R_owns A_R
      have "read_only (𝒮W RA L)  (𝒪  A - R)  all_acquired sb 
        read_only 𝒮  𝒪  (A  all_acquired sb)"
        by (auto simp add: read_only_def augment_shared_def restrict_shared_def split: option.splits)
      finally
      show ?thesis
        by (simp add: Writesb True)
    next
      case False with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis
      by auto
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb )
    from Cons.hyps [OF  consis']
    have "read_only (share sb (𝒮W RA L))
               read_only (𝒮W RA L)  (𝒪  A - R)  all_acquired sb"
      by auto
    also from A_shared_owns L_A R_owns A_R
    have "read_only (𝒮W RA L)  (𝒪  A - R)  all_acquired sb 
        read_only 𝒮  𝒪  (A  all_acquired sb)"
      by (auto simp add: read_only_def augment_shared_def restrict_shared_def split: option.splits)
    finally
    show ?thesis
      by (simp add: Ghostsb)
  qed
qed


      
lemma (in valid_ownership_and_sharing) outstanding_non_write_non_vol_reads_drop_disj:
assumes i_bound: "i < length ts"
assumes j_bound: "j < length ts"
assumes neq_i_j: "i  j"
assumes ith: "ts!i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
assumes jth: "ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
shows "outstanding_refs is_Writesb (dropWhile (Not  is_volatile_Writesb) sbi)  
         outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) sbj)
         = {}" 
proof -

  let ?take_j = "(takeWhile (Not  is_volatile_Writesb) sbj)"
  let ?drop_j = "(dropWhile (Not  is_volatile_Writesb) sbj)"

  let ?take_i = "(takeWhile (Not  is_volatile_Writesb) sbi)"
  let ?drop_i = "(dropWhile (Not  is_volatile_Writesb) sbi)"


  note nvo_i = outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ith]
  note nvo_j = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]
  note nro_i = no_outstanding_write_to_read_only_memory [OF i_bound ith]
  with no_write_to_read_only_memory_append [of 𝒮 ?take_i ?drop_i]
  have nro_drop_i: "no_write_to_read_only_memory (share ?take_i 𝒮) ?drop_i"
    by simp
  note nro_j = no_outstanding_write_to_read_only_memory [OF j_bound jth]
  with no_write_to_read_only_memory_append [of 𝒮 ?take_j ?drop_j]
  have nro_drop_j: "no_write_to_read_only_memory (share ?take_j 𝒮) ?drop_j"
    by simp
  from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound neq_i_j ith jth]
  have dist: "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sbi = {}".
  note own_dist = ownership_distinct [OF i_bound j_bound neq_i_j ith jth]




  from sharing_consis [OF j_bound jth]
  have consis_j: "sharing_consistent 𝒮 𝒪j sbj".
  with sharing_consistent_append [of 𝒮 𝒪j ?take_j ?drop_j]
  obtain
    consis_take_j: "sharing_consistent 𝒮 𝒪j ?take_j" and
    consis_drop_j: "sharing_consistent (share ?take_j 𝒮) (acquired True ?take_j 𝒪j) ?drop_j"
    by simp
    
  from sharing_consis [OF i_bound ith]
  have consis_i: "sharing_consistent 𝒮 𝒪i sbi".
  with sharing_consistent_append [of 𝒮 𝒪i ?take_i ?drop_i]
  have consis_drop_i: "sharing_consistent (share ?take_i 𝒮) (acquired True ?take_i 𝒪i) ?drop_i"
    by simp


  {
    fix x
    assume x_in_drop_i: "x  outstanding_refs is_Writesb ?drop_i"
    assume x_in_drop_j: "x  outstanding_refs is_non_volatile_Readsb ?drop_j"
    have False
    proof -
      from x_in_drop_i have x_in_i: "x  outstanding_refs is_Writesb sbi"
	using outstanding_refs_append [of is_Writesb ?take_i ?drop_i] by auto

      from x_in_drop_j have x_in_j: "x  outstanding_refs is_non_volatile_Readsb sbj"
	using outstanding_refs_append [of is_non_volatile_Readsb ?take_j ?drop_j]
	by auto
      from non_volatile_owned_or_read_only_drop [OF nvo_j]
      have nvo_drop_j: "non_volatile_owned_or_read_only True (share ?take_j 𝒮) (acquired True ?take_j 𝒪j) ?drop_j".

      from non_volatile_reads_acquired_or_read_only_reads [OF nvo_drop_j ] x_in_drop_j 
        acquired_takeWhile_non_volatile_Writesb [of sbj 𝒪j]
      have x_j: "x  𝒪j  all_acquired sbj  read_only_reads (acquired True ?take_j 𝒪j) ?drop_j" 
	using all_acquired_append [of ?take_j ?drop_j]
	by ( auto )

      {
	assume x_in_vol_drop_i: "x  outstanding_refs is_volatile_Writesb ?drop_i"
	hence x_in_vol_i: "x  outstanding_refs is_volatile_Writesb sbi"
	  using outstanding_refs_append [of is_volatile_Writesb ?take_i ?drop_i]
	  by auto

	from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound neq_i_j ith jth]
	have "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sbi = {}". 
	with x_in_vol_i x_j obtain  
	  x_unacq_j: "x   𝒪j  all_acquired sbj" and
	  x_ror_j: "x  read_only_reads (acquired True ?take_j 𝒪j) ?drop_j"
	  by auto
	from read_only_reads_unowned [OF j_bound i_bound neq_i_j [symmetric] jth ith] x_ror_j
	have "x  𝒪i  all_acquired sbi"
	  by auto

	moreover 


	from read_only_reads_read_only [OF nvo_drop_j  consis_drop_j] x_ror_j x_unacq_j 
	  all_acquired_append [of ?take_j ?drop_j] acquired_takeWhile_non_volatile_Writesb [of sbj 𝒪j]
	have "x  read_only (share ?take_j 𝒮)"
	  by (auto)
        
        from read_only_share [OF consis_take_j] this x_unacq_j all_acquired_append [of ?take_j ?drop_j]
        have "x  read_only 𝒮"
	  by auto

	with no_unacquired_write_to_read_only'' [OF nro_i consis_i]  x_in_i
	have "x  𝒪i  all_acquired sbi"
	  by auto

	ultimately have False by auto
      }
      moreover
      {
	assume x_in_non_vol_drop_i: "x  outstanding_refs is_non_volatile_Writesb ?drop_i"
	hence "x  outstanding_refs is_non_volatile_Writesb sbi"
	  using outstanding_refs_append [of is_non_volatile_Writesb ?take_i ?drop_i]
	  by auto
	with non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF nvo_i]
	have "x  𝒪i  all_acquired sbi" by auto

	moreover

	with x_j own_dist obtain
	  x_unacq_j: "x   𝒪j  all_acquired sbj" and
	  x_ror_j: "x  read_only_reads (acquired True ?take_j 𝒪j) ?drop_j"
	  by auto
	from read_only_reads_unowned [OF j_bound i_bound neq_i_j [symmetric] jth ith] x_ror_j
	have "x  𝒪i  all_acquired sbi"
	  by auto

	ultimately have False
	  by auto
      }
      ultimately
      
      show ?thesis
	using x_in_drop_i x_in_drop_j
	by (auto simp add: misc_outstanding_refs_convs)
    qed
  }
  thus ?thesis
    by auto
qed
  
lemma (in valid_ownership_and_sharing) outstanding_non_volatile_write_disj:
assumes i_bound: "i < length ts"
assumes j_bound: "j < length ts"
assumes neq_i_j: "i  j"
assumes ith: "ts!i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
assumes jth: "ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
shows "outstanding_refs (is_non_volatile_Writesb) (takeWhile (Not  is_volatile_Writesb) sbi)  
        (outstanding_refs is_volatile_Writesb sbj   
         outstanding_refs is_non_volatile_Writesb sbj  
         outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) sbj)  
         (outstanding_refs is_non_volatile_Readsb (takeWhile (Not  is_volatile_Writesb) sbj) - 
          read_only_reads 𝒪j (takeWhile (Not  is_volatile_Writesb) sbj))  
         (𝒪j  all_acquired (takeWhile (Not  is_volatile_Writesb) sbj))
        ) = {}" (is "?non_vol_writes_i  ?not_volatile_j = {}")
proof -
  note nro_i = no_outstanding_write_to_read_only_memory [OF i_bound ith]
  note nro_j = no_outstanding_write_to_read_only_memory [OF j_bound jth]
  note nvo_j = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]
  note nvo_i = outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ith]
    
  from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound neq_i_j ith jth]
  have dist: "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sbi = {}".
  
  from outstanding_volatile_writes_unowned_by_others [OF j_bound i_bound neq_i_j [symmetric] jth ith]
  have dist_j: "(𝒪i  all_acquired sbi)  outstanding_refs is_volatile_Writesb sbj = {}".
  
  note own_dist = ownership_distinct [OF i_bound j_bound neq_i_j ith jth]
  
  from sharing_consis [OF j_bound jth]
  have consis_j: "sharing_consistent 𝒮 𝒪j sbj".
  
  from sharing_consis [OF i_bound ith]
  have consis_i: "sharing_consistent 𝒮 𝒪i sbi".
  
  let ?take_j = "(takeWhile (Not  is_volatile_Writesb) sbj)"
  let ?drop_j = "(dropWhile (Not  is_volatile_Writesb) sbj)"


  { 
    fix x
    assume x_in_take_i: "x  ?non_vol_writes_i"
    assume x_in_j: "x  ?not_volatile_j"
    from x_in_take_i have x_in_i: "x  outstanding_refs (is_non_volatile_Writesb) sbi"
      by (auto dest: outstanding_refs_takeWhileD)
    from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF nvo_i] x_in_i
    have x_in_owns_acq_i: "x  𝒪i  all_acquired sbi"
      by auto
    have False
    proof -
      {
	assume x_in_j: "x  outstanding_refs is_volatile_Writesb sbj" 
	with dist_j have x_notin: "x  (𝒪i  all_acquired sbi)"
	  by auto
	with x_in_owns_acq_i have False
	  by auto
      }
      moreover
      {
	assume x_in_j: "x  outstanding_refs is_non_volatile_Writesb sbj"
	from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF nvo_j] x_in_j
	have "x  𝒪j  all_acquired sbj"
	  by auto
	with x_in_owns_acq_i own_dist
	have False
	  by auto
      }
      moreover
      {
	assume x_in_j: "x  outstanding_refs is_non_volatile_Readsb ?drop_j"
	  
	from non_volatile_owned_or_read_only_drop [OF nvo_j]
	have nvo': "non_volatile_owned_or_read_only True (share ?take_j 𝒮) (acquired True ?take_j 𝒪j) ?drop_j".

	from non_volatile_owned_or_read_only_outstanding_refs [OF nvo'] x_in_j
	have "x  acquired True ?take_j 𝒪j  all_acquired ?drop_j   
	  read_only_reads (acquired True ?take_j 𝒪j) ?drop_j"
	  by (auto simp add: misc_outstanding_refs_convs)
	
	moreover 
	from acquired_append [of True ?take_j ?drop_j 𝒪j] acquired_all_acquired [of True ?take_j 𝒪j]
	  all_acquired_append [of ?take_j ?drop_j]
	have "acquired True ?take_j 𝒪j  all_acquired ?drop_j  𝒪j  all_acquired sbj"
	  by auto
	ultimately 
	have "x  read_only_reads (acquired True ?take_j 𝒪j) ?drop_j"
	  using x_in_owns_acq_i own_dist
	  by auto
	
	with read_only_reads_unowned [OF j_bound i_bound neq_i_j [symmetric] jth ith] x_in_owns_acq_i
	have False
	  by auto
      }
      moreover
      {
	assume x_in_j: "x  outstanding_refs is_non_volatile_Readsb ?take_j" 
	assume x_notin: "x  read_only_reads 𝒪j ?take_j"
	from non_volatile_owned_or_read_only_append [where xs="?take_j" and ys="?drop_j"] nvo_j
	have "non_volatile_owned_or_read_only False 𝒮 𝒪j ?take_j"
	  by auto
	
	from non_volatile_owned_or_read_only_outstanding_refs [OF this]  x_in_j x_notin
	have "x  𝒪j  all_acquired ?take_j" 
	  by (auto simp add: misc_outstanding_refs_convs )
	with all_acquired_append [of ?take_j ?drop_j] x_in_owns_acq_i own_dist
	have False
	  by auto
      }
      moreover
      {
	assume x_in_j: "x  𝒪j  all_acquired ?take_j"
	moreover
	from all_acquired_append [of ?take_j ?drop_j]
	have "all_acquired ?take_j  all_acquired sbj"
	  by auto
	ultimately have False
	  using x_in_owns_acq_i own_dist
	  by auto
      }
      ultimately show ?thesis
	using x_in_take_i x_in_j
	by (auto simp add: misc_outstanding_refs_convs)
    qed
  }
  then show ?thesis
    by auto
qed

lemma (in valid_ownership_and_sharing) outstanding_non_volatile_write_not_volatile_read_disj:
assumes i_bound: "i < length ts"
assumes j_bound: "j < length ts"
assumes neq_i_j: "i  j"
assumes ith: "ts!i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
assumes jth: "ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
shows "outstanding_refs (is_non_volatile_Writesb) (takeWhile (Not  is_volatile_Writesb) sbi)  
        outstanding_refs (Not  is_volatile_Readsb) (dropWhile (Not  is_volatile_Writesb) sbj) = {}" 
  (is "?non_vol_writes_i  ?not_volatile_j = {}")
proof -
  have "outstanding_refs (Not  is_volatile_Readsb) (dropWhile (Not  is_volatile_Writesb) sbj)  
    outstanding_refs is_volatile_Writesb sbj   
    outstanding_refs is_non_volatile_Writesb sbj  
    outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) sbj)"
    by (auto simp add: misc_outstanding_refs_convs dest: outstanding_refs_dropWhileD)
  with outstanding_non_volatile_write_disj [OF i_bound j_bound neq_i_j ith jth]
  show ?thesis
    by blast
qed



lemma (in valid_ownership_and_sharing) outstanding_refs_is_Writesb_takeWhile_disj:
        "i < length ts. (j < length ts. i  j 
                  (let (_,_,_,sbi,_,_,_) = ts!i;
                      (_,_,_,sbj,_,_,_) = ts!j
                   in outstanding_refs is_Writesb sbi  
                      outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj) = {}))"
proof -
  {
    fix i j pi isi 𝒪i i 𝒟i θi sbi pj isj 𝒪j j 𝒟j θj sbj
    assume i_bound: "i < length ts"
    assume j_bound: "j < length ts"
    assume neq_i_j: "i  j"
    assume ith: "ts!i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
    assume jth: "ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
    from outstanding_non_volatile_write_disj [OF j_bound i_bound neq_i_j[symmetric] jth ith]
    have "outstanding_refs is_Writesb sbi  
                      outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj) = {}"
      apply (clarsimp simp add: outstanding_refs_is_non_volatile_Writesb_takeWhile_conv)
      apply (auto simp add: misc_outstanding_refs_convs )
      done
  }
  thus ?thesis
    by (fastforce simp add: Let_def)
qed



fun read_tmps:: "'p store_buffer  tmp set"
where
  "read_tmps [] = {}"
| "read_tmps (r#rs) =
     (case r of 
       Readsb volatile a t v  insert t (read_tmps rs)
      | _  read_tmps rs)"


lemma in_read_tmps_conv:
  "(t  read_tmps xs) = (volatile a v. Readsb volatile a t v  set xs)"
  by (induct xs) (auto split: memref.splits)


lemma read_tmps_mono: "ys. set xs  set ys  read_tmps xs  read_tmps ys"
  by (fastforce simp add: in_read_tmps_conv)



fun distinct_read_tmps:: "'p store_buffer  bool"
where
  "distinct_read_tmps [] = True"
| "distinct_read_tmps (r#rs) =
     (case r of 
         Readsb volatile a t v  t  (read_tmps rs)  distinct_read_tmps rs
       | _  distinct_read_tmps rs)"
 
lemma distinct_read_tmps_conv:
 "distinct_read_tmps xs = (i < length xs. j < length xs. i  j 
      (case xs!i of 
         Readsb _ _ ti _  case xs!j of Readsb _ _ tj _  ti  tj | _  True
       | _  True))"
― ‹Nice lemma, ugly proof.›
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x xs)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v)
    with Cons.hyps show ?thesis
      apply -
      apply (rule iffI [rule_format]) 
      apply  clarsimp
             subgoal for i j
             apply (case_tac i)
             apply  fastforce
             apply (case_tac j)
             apply  (fastforce split: memref.splits) 
             apply (clarsimp cong: memref.case_cong)
             done
      apply clarsimp
      subgoal for i j
      apply (erule_tac x="Suc i" in allE)
      apply  clarsimp
      apply (erule_tac x="Suc j" in allE)
      apply  (clarsimp cong: memref.case_cong)
      done
      done
  next
    case (Readsb volatile a t v)
    with Cons.hyps show ?thesis
      apply -
      apply (rule iffI [rule_format]) 
      apply  clarsimp
             subgoal for i j 
             apply (case_tac i)
             apply  clarsimp
             apply  (case_tac j)
             apply   clarsimp
             apply  (fastforce split: memref.splits simp add: in_read_tmps_conv dest: nth_mem)
             apply (clarsimp)
             apply (case_tac j)
             apply  (fastforce split: memref.splits simp add: in_read_tmps_conv dest: nth_mem)
             apply (clarsimp cong: memref.case_cong)
             done
      apply clarsimp
      apply (rule conjI)
      apply (clarsimp simp add: in_read_tmps_conv)
      apply  (erule_tac x="0" in allE)
      apply  (clarsimp simp add: in_set_conv_nth)
             subgoal for volatile' a' v' i
             apply  (erule_tac x="Suc i" in allE)
             apply  clarsimp
             done
      apply clarsimp
      subgoal for i j
      apply (erule_tac x="Suc i" in allE)
      apply clarsimp
      apply (erule_tac x="Suc j" in allE)
      apply (clarsimp cong: memref.case_cong)
      done
      done
  next
    case Progsb
    with Cons.hyps show ?thesis
      apply -
      apply (rule iffI [rule_format]) 
      apply  clarsimp
             subgoal for i j
             apply (case_tac i)
             apply  fastforce
             apply (case_tac j)
             apply  (fastforce split: memref.splits) 
             apply (clarsimp cong: memref.case_cong)
             done
      apply clarsimp
      subgoal for i j
      apply (erule_tac x="Suc i" in allE)
      apply  clarsimp
      apply (erule_tac x="Suc j" in allE)
      apply  (clarsimp cong: memref.case_cong)
      done
      done
  next
    case Ghostsb
    with Cons.hyps show ?thesis
      apply -
      apply (rule iffI [rule_format]) 
      apply  clarsimp
             subgoal for i j
             apply (case_tac i)
             apply  fastforce
             apply (case_tac j)
             apply  (fastforce split: memref.splits) 
             apply (clarsimp cong: memref.case_cong)
             done
      apply clarsimp
      subgoal for i j
      apply (erule_tac x="Suc i" in allE)
      apply  clarsimp
      apply (erule_tac x="Suc j" in allE)
      apply (clarsimp cong: memref.case_cong)
      done
      done
  qed
qed

fun load_tmps:: "instrs  tmp set"
where
  "load_tmps [] = {}"
| "load_tmps (i#is) =
     (case i of
        Read volatile a t  insert t (load_tmps is)
      | RMW _ t _ _ _ _ _ _ _   insert t (load_tmps is)
      | _  load_tmps is)"

lemma in_load_tmps_conv:
  "(t  load_tmps xs) = ((volatile a. Read volatile a t  set xs) 
                         (a sop cond ret A L R W. RMW a t sop cond ret A L R W  set xs))"
  by (induct xs) (auto split: instr.splits)

lemma load_tmps_mono: "ys. set xs  set ys  load_tmps xs  load_tmps ys"
  by (fastforce simp add: in_load_tmps_conv)

fun distinct_load_tmps:: "instrs  bool"
where
  "distinct_load_tmps [] = True"
| "distinct_load_tmps (r#rs) =
     (case r of 
         Read volatile a t  t  (load_tmps rs)  distinct_load_tmps rs
       | RMW a t sop cond ret A L R W  t  (load_tmps rs)  distinct_load_tmps rs
       | _  distinct_load_tmps rs)"


locale load_tmps_distinct =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes load_tmps_distinct:
  "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)  
   
   distinct_load_tmps is"

locale read_tmps_distinct =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes read_tmps_distinct:
  "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)  
   
   distinct_read_tmps sb"

locale load_tmps_read_tmps_distinct =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes load_tmps_read_tmps_distinct:
  "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)  
   
   load_tmps is  read_tmps sb = {}"

locale tmps_distinct = 
  load_tmps_distinct + 
  read_tmps_distinct + 
  load_tmps_read_tmps_distinct

lemma rev_read_tmps: "read_tmps (rev xs) = read_tmps xs"
  by (auto simp add: in_read_tmps_conv)

lemma rev_load_tmps: "load_tmps (rev xs) = load_tmps xs"
  by (auto simp add: in_load_tmps_conv)

lemma distinct_read_tmps_append: "ys. distinct_read_tmps (xs @ ys) = 
        (distinct_read_tmps xs  distinct_read_tmps ys 
        read_tmps xs  read_tmps ys = {})" 
by (induct xs) (auto split: memref.splits simp add: in_read_tmps_conv)

lemma distinct_load_tmps_append: "ys. distinct_load_tmps (xs @ ys) = 
        (distinct_load_tmps xs  distinct_load_tmps ys 
        load_tmps xs  load_tmps ys = {})" 
apply (induct xs) 
apply (auto split: instr.splits simp add: in_load_tmps_conv)
done

lemma read_tmps_append: "read_tmps (xs@ys) = (read_tmps xs  read_tmps ys)"
  by (fastforce simp add: in_read_tmps_conv)

lemma load_tmps_append: "load_tmps (xs@ys) = (load_tmps xs  load_tmps ys)"
  by (fastforce simp add: in_load_tmps_conv)

fun write_sops:: "'p store_buffer  sop set"
where
  "write_sops [] = {}"
| "write_sops (r#rs) =
     (case r of 
       Writesb volatile a sop v _ _ _ _ insert sop (write_sops rs)
      | _  write_sops rs)"

lemma in_write_sops_conv:
  "(sop  write_sops xs) = (volatile a v A L R W. Writesb volatile a sop v A L R W  set xs)"
  apply (induct xs) 
  apply  simp
  apply (auto split: memref.splits) 
  apply  force
  apply force
  done

lemma write_sops_mono: "ys. set xs  set ys  write_sops xs  write_sops ys"
  by (fastforce simp add: in_write_sops_conv)

lemma write_sops_append: "write_sops (xs@ys) = write_sops xs  write_sops ys"
  by (force simp add: in_write_sops_conv)

  
fun store_sops:: "instrs  sop set"
where
  "store_sops [] = {}"
| "store_sops (i#is) =
     (case i of
        Write volatile a sop _ _ _ _  insert sop (store_sops is)
      | RMW a t sop cond ret A L R W  insert sop (store_sops is) 
      | _  store_sops is)"

lemma in_store_sops_conv:
  "(sop  store_sops xs) = ((volatile a A L R W. Write volatile a sop A L R W  set xs) 
                            (a t cond ret A L R W. RMW a t sop cond ret A L R W  set xs))"
  by (induct xs) (auto split: instr.splits)

lemma store_sops_mono: "ys. set xs  set ys  store_sops xs  store_sops ys"
  by (fastforce simp add: in_store_sops_conv)

lemma store_sops_append: "store_sops (xs@ys) = store_sops xs  store_sops ys"
  by (force simp add: in_store_sops_conv)

locale valid_write_sops =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes valid_write_sops:
  "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,) 
   
   sop  write_sops sb. valid_sop sop"

locale valid_store_sops =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes valid_store_sops:
  "i is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,) 
   
   sop  store_sops is. valid_sop sop"

locale valid_sops = valid_write_sops + valid_store_sops

text ‹The value stored in a non-volatile @{const "Readsb"} in the store-buffer has to match the
 last value written to the same address in the store buffer 
 or the memory content if there is no corresponding write in the store buffer.
 No volatile read may follow a volatile write.
 Volatile reads in the store buffer may refer to a stale value:
  e.g. imagine one writer and multiple readers
›

(* Readsb-only reads in the takeWhile part of the store buffer may become stale*)
(* FIXME: The flushing stuff: outstanding_refs is_volatile_Readsb rs = {} ∧ acquired_reads True rs (A - R) = {}
   does not fit well in this definition (it is not memory dependent).
   Maybe it would fit better to sharing_consistent.
*)
fun reads_consistent:: "bool  owns  memory  'p store_buffer  bool"
where
  "reads_consistent pending_write 𝒪 m [] = True"
| "reads_consistent pending_write 𝒪 m (r#rs) = 
   (case r of 
      Readsb volatile a t v  (¬ volatile  (pending_write  a  𝒪)  v = m a)  
                             reads_consistent pending_write 𝒪 m rs
    | Writesb volatile a sop v A L R W  
        (if volatile then
             outstanding_refs is_volatile_Readsb rs = {}  
             reads_consistent True (𝒪  A - R) (m(a := v)) rs
         else reads_consistent pending_write 𝒪 (m(a := v)) rs)
    | Ghostsb A L R W  reads_consistent pending_write (𝒪  A - R) m rs
    | _  reads_consistent pending_write 𝒪 m rs
   )"

fun volatile_reads_consistent:: "memory  'p store_buffer  bool"
where
  "volatile_reads_consistent m [] = True"
| "volatile_reads_consistent m (r#rs) = 
   (case r of 
      Readsb volatile a t v  (volatile  v = m a)  volatile_reads_consistent m rs
    | Writesb volatile a sop v A L R W  volatile_reads_consistent (m(a := v)) rs 
    | _  volatile_reads_consistent m rs
   )"

fun flush:: "'p store_buffer  memory  memory"
where
  "flush [] m = m"
| "flush (r#rs) m =
     (case r of 
        Writesb volatile a _ v _ _ _ _  flush rs (m(a:=v))
      | _  flush rs m)"

lemma reads_consistent_pending_write_antimono:
  "𝒪 m. reads_consistent True 𝒪 m sb  reads_consistent False 𝒪 m sb"
apply (induct sb)
apply  simp
subgoal for a sb 𝒪 m
  by (case_tac a) auto
done

lemma reads_consistent_owns_antimono:
  "𝒪 𝒪' pending_write m.
       𝒪  𝒪'  reads_consistent pending_write 𝒪' m sb  reads_consistent pending_write 𝒪 m sb"
apply (induct sb)
apply  simp
subgoal for a sb 𝒪 𝒪' pending_write m
apply (case_tac a)
apply    (clarsimp split: if_split_asm)
         subgoal for volatile a D f v A L R W
         apply (drule_tac C="A" in union_mono_aux)
         apply (drule_tac C="R" in set_minus_mono_aux)
         apply blast
         done
apply   fastforce
apply  fastforce
apply clarsimp
subgoal for A L R W 
apply (drule_tac C="A" in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
done
done

lemma acquired_reads_mono': "x  acquired_reads b xs A  acquired_reads b xs B = {}  A  B  False"
apply (drule acquired_reads_mono_in [where B=B])
apply auto
done


lemma reads_consistent_append: 
  "m pending_write 𝒪. reads_consistent pending_write 𝒪 m (xs@ys) = 
      (reads_consistent pending_write 𝒪 m xs 
       reads_consistent (pending_write  outstanding_refs is_volatile_Writesb xs  {}) 
          (acquired True xs 𝒪) (flush xs m) ys 
       (outstanding_refs is_volatile_Writesb xs  {}
         outstanding_refs is_volatile_Readsb ys = {} ))"
apply (induct xs)
apply  clarsimp
subgoal for a xs m pending_write 𝒪
apply (case_tac a)
apply (auto simp add: outstanding_refs_append acquired_reads_append
dest: acquired_reads_mono_in acquired_pending_write_mono_in acquired_reads_mono' acquired_mono_in)
done
done


lemma reads_consistent_mem_eq_on_non_volatile_reads:
  assumes mem_eq: "a  A. m' a = m a"
  assumes subset: "outstanding_refs (is_non_volatile_Readsb) sb  A"
  ― ‹We could be even more restrictive here, only the non volatile reads that are
        not buffered in @{term "sb"} have to be the same.›
  assumes consis_m: "reads_consistent pending_write 𝒪 m sb"
  shows "reads_consistent pending_write 𝒪 m' sb"
using mem_eq subset consis_m 
proof (induct sb arbitrary: m' m pending_write 𝒪)
  case Nil thus ?case by simp
next
  case (Cons r sb)
  note mem_eq = a  A. m' a = m a
  note subset = ‹outstanding_refs (is_non_volatile_Readsb) (r#sb)  A
  note consis_m = ‹reads_consistent pending_write 𝒪 m (r#sb)

  from subset have subset': "outstanding_refs is_non_volatile_Readsb sb  A"
    by (auto simp add: Writesb)
  show ?case
  proof (cases r)
    case (Writesb volatile a sop v A' L R W)
    from mem_eq
    have mem_eq': 
      "a'  A. (m'(a:=v)) a' = (m(a:=v)) a'"
      by (auto)
    show ?thesis
    proof (cases volatile)
      case True
      from consis_m obtain
	consis': "reads_consistent True (𝒪  A' - R) (m(a := v)) sb" and
        no_volatile_Readsb: "outstanding_refs is_volatile_Readsb sb = {}" 
	by (simp add: Writesb True)

      from Cons.hyps [OF mem_eq' subset' consis']
      have "reads_consistent True (𝒪  A' - R) (m'(a := v)) sb".
      with no_volatile_Readsb
      show ?thesis
	by (simp add: Writesb True)
    next
      case False
      from consis_m obtain consis': "reads_consistent pending_write 𝒪 (m(a := v)) sb" 
	by (simp add: Writesb False)
      from Cons.hyps [OF mem_eq' subset' consis']
      have "reads_consistent pending_write 𝒪 (m'(a := v)) sb".
      then
      show ?thesis
	by (simp add: Writesb False)
    qed
  next
    case (Readsb volatile a t v)
    from mem_eq
    have mem_eq': 
      "a'  A. m' a' = m a'"
      by (auto)
    show ?thesis
    proof (cases volatile)
      case True
      from consis_m obtain	
	consis': "reads_consistent pending_write 𝒪 m sb"  
	by (simp add: Readsb True)
      from Cons.hyps [OF mem_eq' subset' consis']
      show ?thesis
	by (simp add: Readsb True)
    next
      case False
      from consis_m obtain	
	consis': "reads_consistent pending_write 𝒪 m sb"  and v: "(pending_write  a  𝒪)  v=m a" 
	by (simp add: Readsb False)
      from mem_eq subset Readsb have "m' a = m a"
	by (auto simp add: False)
      with Cons.hyps [OF mem_eq' subset' consis'] v
      show ?thesis
	by (simp add: Readsb False)
    qed
  next
    case Progsb with Cons show ?thesis by auto
  next
    case Ghostsb with Cons show ?thesis by auto
  qed
qed



lemma volatile_reads_consistent_mem_eq_on_volatile_reads:
  assumes mem_eq: "a  A. m' a = m a"
  assumes subset: "outstanding_refs (is_volatile_Readsb) sb  A"
  ― ‹We could be even more restrictive here, only the non volatile reads that are
        not buffered in @{term "sb"} have to be the same.›
  assumes consis_m: "volatile_reads_consistent m sb"
  shows "volatile_reads_consistent m' sb"
using mem_eq subset consis_m 
proof (induct sb arbitrary: m' m)
  case Nil thus ?case by simp
next
  case (Cons r sb)
  note mem_eq = a  A. m' a = m a
  note subset = ‹outstanding_refs (is_volatile_Readsb) (r#sb)  A
  note consis_m = ‹volatile_reads_consistent m (r#sb)

  from subset have subset': "outstanding_refs is_volatile_Readsb sb  A"
    by (auto simp add: Writesb)
  show ?case
  proof (cases r)
    case (Writesb volatile a sop v A' L R W)
    from mem_eq
    have mem_eq': 
      "a'  A. (m'(a:=v)) a' = (m(a:=v)) a'"
      by (auto)
    show ?thesis
    proof (cases volatile)
      case True
      from consis_m obtain
	consis': "volatile_reads_consistent (m(a := v)) sb"
	by (simp add: Writesb True)

      from Cons.hyps [OF mem_eq' subset' consis']
      have "volatile_reads_consistent (m'(a := v)) sb".
      then
      show ?thesis
	by (simp add: Writesb True)
    next
      case False
      from consis_m obtain consis': "volatile_reads_consistent (m(a := v)) sb" 
	by (simp add: Writesb False)
      from Cons.hyps [OF mem_eq' subset' consis']
      have "volatile_reads_consistent (m'(a := v)) sb".
      then
      show ?thesis
	by (simp add: Writesb False)
    qed
  next
    case (Readsb volatile a t v)
    from mem_eq
    have mem_eq': 
      "a'  A. m' a' = m a'"
      by (auto)
    show ?thesis
    proof (cases volatile)
      case False
      from consis_m obtain	
	consis': "volatile_reads_consistent m sb"  
	by (simp add: Readsb False)
      from Cons.hyps [OF mem_eq' subset' consis']
      show ?thesis
	by (simp add: Readsb False)
    next
      case True
      from consis_m obtain	
	consis': "volatile_reads_consistent m sb"  and v: "v=m a" 
	by (simp add: Readsb True)
      from mem_eq subset Readsb v have "v = m' a"
	by (auto simp add: True)
      with Cons.hyps [OF mem_eq' subset' consis'] 
      show ?thesis
	by (simp add: Readsb True)
    qed
  next
    case Progsb with Cons show ?thesis by auto
  next
    case Ghostsb with Cons show ?thesis by auto
  qed
qed

locale valid_reads =
fixes m::"memory"  and ts::"('p, 'p store_buffer,bool,owns,rels) thread_config list" 
assumes valid_reads: "i p is 𝒪  𝒟 θ sb. 
          i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)   
            reads_consistent False 𝒪 m sb"

lemma valid_reads_Cons: "valid_reads m (t#ts) = 
  (let (_,_,_,sb,_,𝒪,_) = t in reads_consistent False 𝒪 m sb  valid_reads m ts)"
apply (auto simp add: valid_reads_def)
subgoal for p' is' θ' sb' 𝒟' 𝒪' ℛ' i p "is" θ sb 𝒟 𝒪 ℛ
apply (case_tac i)
apply auto
done
done



text Readsbs› and writes have in the store-buffer have to conform to the 
  valuation of temporaries.›
context program
begin
fun history_consistent:: "tmps  'p  'p store_buffer  bool"
where
  "history_consistent θ p [] = True"
| "history_consistent θ p (r#rs) =
    (case r of
       Readsb vol a t v  
         (case θ t of Some v'  v=v'  history_consistent θ p rs | _  False) 
     | Writesb vol a (D,f) v _ _ _ _  
           D  dom θ  f θ = v  D  read_tmps rs = {}  history_consistent θ p rs
     | Progsb p1 p2 is  p1=p  
                           θ|`(dom θ - read_tmps rs) p1 p (p2,is)  
                           history_consistent θ p2 rs
     | _  history_consistent θ p rs)"
end

fun hd_prog:: "'p  'p store_buffer  'p"
where
  "hd_prog p [] = p"
| "hd_prog p (i#is) = (case i of
      Progsb p' _ _  p'
    | _  hd_prog p is)" 

fun last_prog:: "'p  'p store_buffer  'p"
where
  "last_prog p [] = p"
| "last_prog p (i#is) = (case i of
      Progsb _ p' _  last_prog p' is
    | _  last_prog p is)" 

locale valid_history = program +
constrains 
  program_step :: "tmps  'p  'p × instrs  bool"  
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list" 
assumes valid_history: "i p is 𝒪  𝒟 θ sb. 
          i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)   
            program.history_consistent program_step θ (hd_prog p sb) sb"

fun data_dependency_consistent_instrs:: "addr set  instrs  bool"
where
  "data_dependency_consistent_instrs T [] = True"
| "data_dependency_consistent_instrs T (i#is) =
     (case i of
        Write volatile a (D,f) _ _ _ _  D  T  D  load_tmps is = {}  data_dependency_consistent_instrs T is
      | RMW a t (D,f) cond ret _ _ _ _  D  T  D  load_tmps is = {}  data_dependency_consistent_instrs (insert t T) is
      | Read _ _ t  data_dependency_consistent_instrs (insert t T) is
      | _  data_dependency_consistent_instrs T is)"

lemma data_dependency_consistent_mono:
" T T'. data_dependency_consistent_instrs T is; T  T'  data_dependency_consistent_instrs T' is"
apply (induct "is")
apply clarsimp
subgoal for a "is" T T'
apply (case_tac a)
apply     clarsimp
          subgoal for volatile a' t
          apply (drule_tac a=t in insert_mono)
          apply clarsimp
          done
apply    fastforce
apply   clarsimp
        subgoal for a' t D f cond ret A L R W 
        apply (frule_tac a=t in insert_mono)
        apply fastforce
        done
apply  fastforce
apply fastforce
done
done


lemma data_dependency_consistent_instrs_append:
  "ys T . data_dependency_consistent_instrs T (xs@ys) =
       (data_dependency_consistent_instrs T xs  
        data_dependency_consistent_instrs (T  load_tmps xs) ys 
        load_tmps ys  (fst ` store_sops xs) = {})"
apply (induct xs)
apply (auto split: instr.splits simp add: load_tmps_append intro: data_dependency_consistent_mono)
done

locale valid_data_dependency =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list" 
assumes data_dependency_consistent_instrs: 
  "i p is 𝒪 𝒟 θ sb. 
          i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)   
            data_dependency_consistent_instrs (dom θ) is"
assumes load_tmps_write_tmps_distinct: 
  "i p is 𝒪 𝒟 θ sb. 
          i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)   
            load_tmps is  (fst ` write_sops sb) = {}"

locale load_tmps_fresh =
fixes ts::"('p, 'p store_buffer,bool,owns,rels) thread_config list" 
assumes load_tmps_fresh: 
  "i p is 𝒪 𝒟 θ sb. 
          i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)   
            load_tmps is  dom θ = {}"

fun acquired_by_instrs :: "instrs  addr set  addr set"
where
  "acquired_by_instrs [] A = A"
| "acquired_by_instrs (i#is) A = 
   (case i of
      Read _ _ _  acquired_by_instrs is A
    | Write volatile _ _ A' L R W  acquired_by_instrs is (if volatile then (A  A' - R) else A)
    | RMW a t sop cond ret A' L R W   acquired_by_instrs is {}
    | Fence    acquired_by_instrs is {}
    | Ghost A' L R W  acquired_by_instrs is (A  A' - R))"

fun acquired_loads :: "bool  instrs  addr set  addr set"
where
  "acquired_loads pending_write [] A = {}"
| "acquired_loads pending_write (i#is) A =
   (case i of
      Read volatile a _  (if pending_write  ¬ volatile  a  A 
                            then insert a (acquired_loads pending_write is A)
                            else acquired_loads pending_write is A)
    | Write volatile _ _ A' L R W  (if volatile then acquired_loads True is (if pending_write then (A  A' - R) else {})
                             else acquired_loads pending_write is A)
    | RMW a t sop cond ret A' L R W   acquired_loads pending_write is {}
    | Fence    acquired_loads pending_write is {}
    | Ghost A' L R W  acquired_loads pending_write is (A  A' - R))"

lemma acquired_by_instrs_mono: 
  " A B. A  B  acquired_by_instrs is A  acquired_by_instrs is B"
apply (induct "is")
apply  simp
subgoal for a "is" A B
apply (case_tac a)
apply      clarsimp
apply     clarsimp
          subgoal for volatile a' D f A' L R W x 
          apply (drule_tac C=A' in union_mono_aux)
          apply (drule_tac C="R" in set_minus_mono_aux)
          apply blast
          done
apply   clarsimp
apply  clarsimp
apply clarsimp
subgoal for A' L R W x
apply (drule_tac C=A' in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
done
done

lemma acquired_by_instrs_mono_in:
  assumes x_in: "x  acquired_by_instrs is A" 
  assumes sub: "A  B" 
  shows "x  acquired_by_instrs is B"
using acquired_by_instrs_mono [OF sub, of "is"] x_in
by blast


locale enough_flushs =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list" 
assumes clean_no_outstanding_volatile_Writesb: 
  "i p is 𝒪  𝒟 θ sb. 
     i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,);¬ 𝒟  
       (outstanding_refs is_volatile_Writesb sb = {})"

fun prog_instrs:: "'p store_buffer  instrs"
where 
  "prog_instrs [] = []"
 |"prog_instrs (i#is) = (case i of
    Progsb _ _ is'  is' @ prog_instrs is
   | _  prog_instrs is)"

fun instrs:: "'p store_buffer  instrs"
where
  "instrs [] = []"
| "instrs (i#is) = (case i of
     Writesb volatile a sop v A L R W  Write volatile a sop A L R W# instrs is
   | Readsb volatile a t v  Read volatile a t # instrs is
   | Ghostsb A L R W  Ghost A L R W# instrs is
   | _  instrs is)"

locale causal_program_history =
fixes "issb" and sb
assumes causal_program_history: 
  "sb1 sb2. sb=sb1@sb2  is. instrs sb2 @ issb = is @ prog_instrs sb2"

lemma causal_program_history_empty [simp]: "causal_program_history is []"
  by (rule causal_program_history.intro) simp

lemma causal_program_history_suffix:
  "causal_program_history issb (sb@sb')  causal_program_history issb sb'"
  by (auto simp add: causal_program_history_def)

locale valid_program_history = 
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list" 
assumes valid_program_history: 
  "i p is 𝒪  𝒟 θ sb. 
     i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)   
      causal_program_history is sb"

assumes valid_last_prog:
  "i p is 𝒪  𝒟 θ sb. 
     i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)   
      last_prog p sb = p"

lemma (in valid_program_history) valid_program_history_nth_update:
 "i < length ts; causal_program_history is sb; last_prog p sb = p 
   
   valid_program_history (ts [i:=(p,is,θ,sb,𝒟,𝒪,)])"
  by (rule valid_program_history.intro)
     (auto dest: valid_program_history valid_last_prog
    simp add: nth_list_update split: if_split_asm)

lemma (in outstanding_non_volatile_refs_owned_or_read_only)
  outstanding_non_volatile_refs_owned_instructions_read_value_independent:
 "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)   
     outstanding_non_volatile_refs_owned_or_read_only 𝒮 (ts[i := (p',is',θ',sb,𝒟',𝒪,ℛ')])"
  by (unfold_locales)
     (auto dest: outstanding_non_volatile_refs_owned_or_read_only 
       simp add:  nth_list_update split: if_split_asm)

lemma (in outstanding_non_volatile_refs_owned_or_read_only)
  outstanding_non_volatile_refs_owned_or_read_only_nth_update:
 "i is 𝒪 𝒟   θ sb. 
   i < length ts; non_volatile_owned_or_read_only False 𝒮 𝒪 sb  
     outstanding_non_volatile_refs_owned_or_read_only 𝒮 (ts[i := (p,is,θ,sb,𝒟,𝒪,)])"
by (unfold_locales)
   (auto dest: outstanding_non_volatile_refs_owned_or_read_only 
       simp add:  nth_list_update split: if_split_asm)

lemma (in outstanding_volatile_writes_unowned_by_others)
  outstanding_volatile_writes_unowned_by_others_instructions_read_value_independent:
 "i p is 𝒪  𝒟  θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)   
     outstanding_volatile_writes_unowned_by_others (ts[i := (p',is',θ',sb,𝒟',𝒪,ℛ')])"
  by (unfold_locales)
     (auto dest: outstanding_volatile_writes_unowned_by_others 
       simp add:  nth_list_update split: if_split_asm)

lemma (in read_only_reads_unowned)
  read_only_unowned_instructions_read_value_independent:
 "i p is 𝒪  𝒟  θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)   
     read_only_reads_unowned (ts[i := (p',is',θ',sb,𝒟',𝒪,ℛ')])"
  by (unfold_locales)
     (auto dest: read_only_reads_unowned
       simp add:  nth_list_update split: if_split_asm)



lemma Writesb_in_outstanding_refs:
  "Writesb True a sop v A L R W  set xs  a  outstanding_refs is_volatile_Writesb xs"
  by (induct xs) (auto split:memref.splits)


lemma (in outstanding_volatile_writes_unowned_by_others)
  outstanding_volatile_writes_unowned_by_others_store_buffer:
 "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,); 
    outstanding_refs is_volatile_Writesb sb'  outstanding_refs is_volatile_Writesb sb;
    all_acquired sb'  all_acquired sb  
     outstanding_volatile_writes_unowned_by_others (ts[i := (p',is',θ',sb',𝒟',𝒪,ℛ')])"
  apply (unfold_locales)
  apply (fastforce dest: outstanding_volatile_writes_unowned_by_others 
         simp add:  nth_list_update split: if_split_asm)
  done


lemma (in ownership_distinct)
  ownership_distinct_instructions_read_value_store_buffer_independent:
 "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,);
     all_acquired sb'  all_acquired sb  
     ownership_distinct (ts[i := (p',is',θ',sb',𝒟',𝒪,ℛ')])"
  by (unfold_locales)
     (auto dest: ownership_distinct 
       simp add:  nth_list_update split: if_split_asm)


lemma (in ownership_distinct)
  ownership_distinct_nth_update:
 "i p is 𝒪  𝒟 xs sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,);
    j < length ts. ij  (let (pj,isj,θj,sbj,𝒟j,𝒪j,j) = ts!j 
          in (𝒪'  all_acquired sb')  (𝒪j  all_acquired sbj) ={})   
     ownership_distinct (ts[i := (p',is',θ',sb',𝒟',𝒪',ℛ')])"
  apply (unfold_locales)
  apply (clarsimp simp add: nth_list_update split: if_split_asm)
  apply   (force dest: ownership_distinct simp add: Let_def)
  apply  (fastforce dest: ownership_distinct simp add: Let_def)
  apply (fastforce dest: ownership_distinct simp add: Let_def)
  done


lemma (in valid_write_sops) valid_write_sops_nth_update:
          "i < length ts; sop  write_sops sb. valid_sop sop  
            valid_write_sops (ts[i := (p,is,xs,sb,𝒟,𝒪,)])"
  by (unfold valid_write_sops_def)
     (auto dest: valid_write_sops simp add: nth_list_update split: if_split_asm)

lemma (in valid_store_sops) valid_store_sops_nth_update:
          "i < length ts; sop  store_sops is. valid_sop sop  
            valid_store_sops (ts[i := (p,is,xs,sb,𝒟,𝒪,)])"
  by (unfold valid_store_sops_def)
     (auto dest: valid_store_sops simp add: nth_list_update split: if_split_asm)

lemma (in valid_sops) valid_sops_nth_update:
          "i < length ts; sop  write_sops sb. valid_sop sop;
            sop  store_sops is. valid_sop sop  
            valid_sops (ts[i := (p,is,xs,sb,𝒟,𝒪,)])"
  by (unfold valid_sops_def valid_write_sops_def valid_store_sops_def)
     (auto dest: valid_write_sops valid_store_sops 
       simp add: nth_list_update split: if_split_asm)


lemma (in valid_data_dependency) valid_data_dependency_nth_update:
          "i < length ts; data_dependency_consistent_instrs (dom θ) is; 
            load_tmps is  (fst ` write_sops sb) = {}  
            valid_data_dependency (ts[i := (p,is,θ,sb,𝒟,𝒪,)])"
  by (unfold valid_data_dependency_def)
     (force dest: data_dependency_consistent_instrs load_tmps_write_tmps_distinct 
         simp add: nth_list_update split: if_split_asm)

lemma (in enough_flushs) enough_flushs_nth_update:
 "i < length ts; 
   ¬ 𝒟  (outstanding_refs is_volatile_Writesb sb = {})
    
     enough_flushs (ts[i := (p,is,θ,sb,𝒟,𝒪,)])"

  apply (unfold_locales)
  apply  (force simp add: nth_list_update split: if_split_asm dest: clean_no_outstanding_volatile_Writesb)
  done

lemma (in outstanding_non_volatile_writes_unshared) 
  outstanding_non_volatile_writes_unshared_nth_update:
          "i < length ts; non_volatile_writes_unshared 𝒮 sb  
            outstanding_non_volatile_writes_unshared 𝒮 (ts[i := (p,is,xs,sb,𝒟,𝒪,)])"
  by (unfold_locales)
     (auto dest: outstanding_non_volatile_writes_unshared 
       simp add: nth_list_update split: if_split_asm)

lemma (in sharing_consis) 
  sharing_consis_nth_update:
          "i < length ts; sharing_consistent 𝒮 𝒪 sb  
            sharing_consis 𝒮 (ts[i := (p,is,xs,sb,𝒟,𝒪,)])"
  by (unfold_locales)
     (auto dest: sharing_consis 
       simp add: nth_list_update split: if_split_asm)



lemma (in no_outstanding_write_to_read_only_memory) 
  no_outstanding_write_to_read_only_memory_nth_update:
          "i < length ts; no_write_to_read_only_memory 𝒮 sb  
            no_outstanding_write_to_read_only_memory 𝒮 (ts[i := (p,is,xs,sb,𝒟,𝒪,)])"
  by (unfold_locales)
     (auto dest:  no_outstanding_write_to_read_only_memory
       simp add: nth_list_update split: if_split_asm)

lemma in_Union_image_nth_conv: "a   (f ` set xs)  i. i < length xs  a  f (xs!i)"    
  by (auto simp add: in_set_conv_nth)

lemma in_Inter_image_nth_conv: "a   (f ` set xs) = (i < length xs. a  f (xs!i))"    
  by (force simp add:  in_set_conv_nth)



lemma release_ownership_nth_update:
  assumes R_subset: "R  𝒪"
  shows "i. i < length ts; ts!i = (p,is,xs,sb,𝒟,𝒪,);
          ownership_distinct ts
      ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set (ts[i:=(p',is',xs',sb',𝒟',𝒪 - R,ℛ')]))
        = (( ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts))  - R )"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  note i_bound = i < length (t # ts)
  note ith = (t # ts) ! i = (p,is,xs, sb, 𝒟, 𝒪,)
  note dist = ‹ownership_distinct (t#ts)
  then interpret ownership_distinct "t#ts".
  from dist
  have dist': "ownership_distinct ts"
    by (rule ownership_distinct_tl)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have t: "t = (p,is,xs,sb,𝒟,𝒪,)"
      by simp
    have "R  ( ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts)) = {}"
    proof -
      {
	fix x
	assume x_R: "x  R"
	assume x_ls: "x  ( ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts))"
	then obtain j pj "isj" 𝒪j j 𝒟j xsj sbj where
	  j_bound: "j < length ts" and
	  jth: "ts!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)" and
	  x_in: "x  𝒪j"
	  by (fastforce simp add: in_set_conv_nth )
	from  j_bound jth 0 
	have "(𝒪  all_acquired sb)  (𝒪j  all_acquired sbj)= {}"
	  apply -
	  apply (rule ownership_distinct [OF i_bound _ _ ith, of "Suc j"])
	  apply clarsimp+
	  apply blast
	  done
	
	with x_R R_subset x_in have False
	  by auto
      }
      thus ?thesis
	by blast
    qed
    then
    show ?thesis
      by (auto simp add: 0 t)  
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l xsl sbl where t: "t = (pl,isl,xsl,sbl,𝒟l,𝒪l,l)"
      by (cases t)

    have n_bound: "n < length ts"
      using i_bound by (simp add: Suc)
    have nth: "ts!n = (p,is,xs,sb,𝒟,𝒪,)"
      using ith by (simp add: Suc)
    
    have "R  (𝒪l  all_acquired sbl) = {}"
    proof -
      {
	fix x
	assume x_R: "x  R"
	assume x_ownsl: "x  (𝒪l  all_acquired sbl)"
	from t 
	have "(𝒪  all_acquired sb)  (𝒪l  all_acquired sbl)= {}"
	  apply -
	  apply (rule ownership_distinct [OF i_bound _ _ ith, of "0"])
	  apply (auto simp add: Suc)
	  done
	with x_ownsl x_R R_subset have False
	  by auto
      }
      thus ?thesis
	by blast
    qed
    with Cons.hyps [OF n_bound nth dist']
    show ?thesis
      by (auto simp add: Suc t)
  qed
qed
   
lemma acquire_ownership_nth_update:
  shows "i. i < length ts; ts!i = (p,is,xs,sb,𝒟,𝒪,)
      ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set (ts[i:=(p',is',xs',sb',𝒟',𝒪  A,ℛ')]))
        = (( ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts))   A )"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  note i_bound = i < length (t # ts)
  note ith = (t # ts) ! i = (p,is, xs, sb, 𝒟, 𝒪, )
  show ?case
  proof (cases i)
    case 0
    from ith 0 have t: "t = (p,is,xs,sb,𝒟,𝒪,)"
      by simp
    show ?thesis
      by (auto simp add: 0 t)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l xsl sbl where t: "t = (pl,isl,xsl,sbl,𝒟l,𝒪l,l)"
      by (cases t)

    have n_bound: "n < length ts"
      using i_bound by (simp add: Suc)
    have nth: "ts!n = (p,is,xs,sb,𝒟,𝒪,)"
      using ith by (simp add: Suc)
    from Cons.hyps [OF n_bound nth]
    show ?thesis
      by (auto simp add: Suc t)
  qed
qed

lemma acquire_release_ownership_nth_update:
  assumes R_subset: "R  𝒪"
  shows "i. i < length ts; ts!i = (p,is,xs,sb,𝒟,𝒪,);
          ownership_distinct ts
      ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set (ts[i:=(p',is',xs',sb',𝒟',𝒪  A - R,ℛ')]))
        = (( ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts))   A - R )"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  note i_bound = i < length (t # ts)
  note ith = (t # ts) ! i = (p,is, xs, sb,𝒟, 𝒪,)
  note dist = ‹ownership_distinct (t#ts)
  then interpret ownership_distinct "t#ts".
  from dist
  have dist': "ownership_distinct ts"
    by (rule ownership_distinct_tl)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have t: "t = (p,is,xs,sb,𝒟,𝒪,)"
      by simp
    have "R  ( ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts)) = {}"
    proof -
      {
	fix x
	assume x_R: "x  R"
	assume x_ls: "x  ( ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts))"
	then obtain j pj "isj" 𝒪j j 𝒟j xsj sbj where
	  j_bound: "j < length ts" and
	  jth: "ts!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)" and
	  x_in: "x  𝒪j"
	  by (fastforce simp add: in_set_conv_nth )
	from  j_bound jth 0 
	have "(𝒪  all_acquired sb)  (𝒪j  all_acquired sbj)= {}"
	  apply -
	  apply (rule ownership_distinct [OF i_bound _ _ ith, of "Suc j"])
	  apply clarsimp+
	  apply blast
	  done
	
	with x_R R_subset x_in have False
	  by auto
      }
      thus ?thesis
	by blast
    qed
    then
    show ?thesis
      by (auto simp add: 0 t)  
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l xsl sbl where t: "t = (pl,isl,xsl,sbl,𝒟l,𝒪l,l)"
      by (cases t)

    have n_bound: "n < length ts"
      using i_bound by (simp add: Suc)
    have nth: "ts!n = (p,is,xs,sb,𝒟,𝒪,)"
      using ith by (simp add: Suc)
    
    have "R  (𝒪l  all_acquired sbl) = {}"
    proof -
      {
	fix x
	assume x_R: "x  R"
	assume x_ownsl: "x  (𝒪l  all_acquired sbl)"
	from t 
	have "(𝒪  all_acquired sb)  (𝒪l  all_acquired sbl)= {}"
	  apply -
	  apply (rule ownership_distinct [OF i_bound _ _ ith, of "0"])
	  apply (auto simp add: Suc)
	  done
	with x_ownsl x_R R_subset have False
	  by auto
      }
      thus ?thesis
	by blast
    qed
    with Cons.hyps [OF n_bound nth dist']
    show ?thesis
      by (auto simp add: Suc t)
  qed
qed



lemma (in valid_history) valid_history_nth_update:
          "i < length ts; history_consistent θ (hd_prog p sb) sb   
            valid_history program_step (ts[i := (p,is,θ,sb,𝒟,𝒪,)])"
  by (unfold_locales)
     (auto dest: valid_history simp add: nth_list_update split: if_split_asm)

lemma (in valid_reads) valid_reads_nth_update:
          "i < length ts; reads_consistent False 𝒪 m sb   
            valid_reads m (ts[i := (p,is,xs,sb,𝒟,𝒪,)])"
  by (unfold_locales)
     (auto dest: valid_reads simp add: nth_list_update split: if_split_asm)

lemma (in load_tmps_distinct) load_tmps_distinct_nth_update:
          "i < length ts; distinct_load_tmps is  
            load_tmps_distinct (ts[i := (p,is,xs,sb,𝒟,𝒪,)])"
  by (unfold_locales)
     (auto dest: load_tmps_distinct simp add: nth_list_update split: if_split_asm)

lemma (in read_tmps_distinct) read_tmps_distinct_nth_update:
          "i < length ts; distinct_read_tmps sb  
            read_tmps_distinct (ts[i := (p,is,xs,sb,𝒟,𝒪,)])"
  by (unfold_locales)
     (auto dest: read_tmps_distinct simp add: nth_list_update split: if_split_asm)

lemma (in load_tmps_read_tmps_distinct) load_tmps_read_tmps_distinct_nth_update:
          "i < length ts; load_tmps is  read_tmps sb = {}  
            load_tmps_read_tmps_distinct (ts[i := (p,is,xs,sb,𝒟,𝒪,)])"
  by (unfold_locales)
     (auto dest: load_tmps_read_tmps_distinct simp add: nth_list_update split: if_split_asm)

lemma (in load_tmps_fresh) load_tmps_fresh_nth_update:
          "i < length ts; 
            load_tmps is  dom θ = {}  
            load_tmps_fresh (ts[i := (p,is,θ,sb,𝒟,𝒪,)])"
  by (unfold_locales)
     (fastforce dest: load_tmps_fresh
         simp add: nth_list_update split: if_split_asm)




fun flush_all_until_volatile_write:: 
  "('p,'p store_buffer,'dirty,'owns,'rels) thread_config list  memory  memory"
where
  "flush_all_until_volatile_write [] m = m"
| "flush_all_until_volatile_write ((_, _, _, sb,_, _)#ts) m =
     flush_all_until_volatile_write ts (flush (takeWhile (Not  is_volatile_Writesb) sb) m)"

fun share_all_until_volatile_write:: 
  "('p,'p store_buffer,'dirty,'owns,'rels) thread_config list  shared  shared"
where
  "share_all_until_volatile_write [] S = S"
| "share_all_until_volatile_write ((_, _, _, sb,_,_)#ts) S =
     share_all_until_volatile_write ts (share (takeWhile (Not  is_volatile_Writesb) sb) S)"





lemma takeWhile_dropWhile_real_prefix: 
  "x  set xs; ¬ P x  y ys. xs=takeWhile P xs @ y#ys  ¬ P y  dropWhile P xs = y#ys"   
  by (induct xs) auto

lemma buffered_val_witness: "buffered_val sb a = Some v  
  volatile sop A L R W.  Writesb volatile a sop v A L R W  set sb"
  apply (induct sb) 
  apply  simp
  apply (clarsimp split: memref.splits option.splits if_split_asm)
  apply  blast
  apply blast
  done


lemma flush_append_Readsb:
  "m. (flush (takeWhile (Not  is_volatile_Writesb) (sb @ [Readsb volatile a t v])) m)
       = flush (takeWhile (Not  is_volatile_Writesb) sb) m"
by (induct sb) (auto split: memref.splits)

lemma flush_append_write:
   "m. (flush (sb @ [Writesb volatile a sop v A L R W]) m) = (flush sb m) (a:=v)"
by (induct sb) (auto split: memref.splits)

lemma flush_append_Progsb:
"m. (flush (takeWhile (Not  is_volatile_Writesb) (sb @ [Progsb p1 p2 mis])) m) = 
       (flush (takeWhile (Not  is_volatile_Writesb) sb) m) "
  by (induct sb) (auto split: memref.splits)

lemma flush_append_Ghostsb:
"m. (flush (takeWhile (Not  is_volatile_Writesb) (sb @ [Ghostsb A L R W])) m) = 
       (flush (takeWhile (Not  is_volatile_Writesb) sb) m) "
  by (induct sb) (auto split: memref.splits)

lemma share_append: "S. share (xs@ys) S = share ys (share xs S)"
  by (induct xs) (auto split: memref.splits)

lemma share_append_Readsb:
  "S. (share (takeWhile (Not  is_volatile_Writesb) (sb @ [Readsb volatile a t v])) S)
       = share (takeWhile (Not  is_volatile_Writesb) sb) S"
 by (induct sb) (auto split: memref.splits)

lemma share_append_Writesb:
  "S. (share (takeWhile (Not  is_volatile_Writesb) (sb @ [Writesb volatile a sop v A L R W])) S)
       = share (takeWhile (Not  is_volatile_Writesb) sb) S"
by (induct sb) (auto split: memref.splits)

lemma share_append_Progsb:
"S. (share (takeWhile (Not  is_volatile_Writesb) (sb @ [Progsb p1 p2 mis])) S) = 
       (share (takeWhile (Not  is_volatile_Writesb) sb) S) "
  by (induct sb) (auto split: memref.splits)

lemma in_acquired_no_pending_write_outstanding_write: 
  "a  acquired False sb A  outstanding_refs is_volatile_Writesb sb  {}"
apply (induct sb)
apply (auto split: memref.splits)
done

lemma flush_buffered_val_conv:
  "m. flush sb m a = (case buffered_val sb a of None  m a | Some v  v)"
  by (induct sb) (auto split: memref.splits option.splits)

(*
lemma reads_consistent_unbuffered_snoc: 
  "⋀m. buffered_val sb a = None ⟹ m a = v ⟹ reads_consistent m sb ⟹
        volatile ⟶ 
          outstanding_refs is_volatile_Writesb sb = {} ⟹ 
        ¬ volatile ⟶ a ∉ acquired False sb {}
  ⟹ reads_consistent m (sb @ [Readsb volatile a t v])"
  by (simp add: reads_consistent_append flush_buffered_val_conv)
*)

lemma reads_consistent_unbuffered_snoc: 
  "m. buffered_val sb a = None  m a = v  reads_consistent pending_write 𝒪 m sb 
        volatile  
          outstanding_refs is_volatile_Writesb sb = {} 
   reads_consistent pending_write 𝒪 m (sb @ [Readsb volatile a t v])"
  by (simp add: reads_consistent_append flush_buffered_val_conv)

lemma reads_consistent_buffered_snoc: 
  "m. buffered_val sb a = Some v   reads_consistent pending_write 𝒪 m sb 
        volatile  outstanding_refs is_volatile_Writesb sb = {} 
   reads_consistent pending_write 𝒪 m (sb @ [Readsb volatile a t v])"
  by (simp add: reads_consistent_append flush_buffered_val_conv)

lemma reads_consistent_snoc_Writesb:
  "m. reads_consistent pending_write 𝒪 m sb  
  reads_consistent pending_write 𝒪 m (sb @ [Writesb volatile a sop v A L R W])"
  by (simp add: reads_consistent_append)

lemma reads_consistent_snoc_Progsb:
  "m. reads_consistent pending_write 𝒪 m sb  reads_consistent pending_write 𝒪 m (sb @ [Progsb p1 p2 mis])"
  by (simp add: reads_consistent_append)

lemma reads_consistent_snoc_Ghostsb:
  "m. reads_consistent pending_write 𝒪 m sb  reads_consistent pending_write 𝒪 m (sb @ [Ghostsb A L R W])"
  by (simp add: reads_consistent_append)

(* FIXME: move to map.thy *)
lemma restrict_map_id [simp]:"m |` dom m = m"
  apply (rule ext)
  subgoal for x
  apply (case_tac "m x")
  apply (auto simp add: restrict_map_def domIff)
  done
  done

lemma flush_all_until_volatile_write_Read_commute:
  shows "m i.  i < length ls; ls!i=(p,Read volatile a t#is,θ,sb,𝒟,𝒪,)
      
    
    flush_all_until_volatile_write 
       (ls[i := (p,is , θ(tv), sb @ [Readsb volatile a t v],𝒟',𝒪',ℛ')]) m =
    flush_all_until_volatile_write ls m"
proof (induct ls)
  case Nil thus ?case
    by simp
next
  case (Cons l ls)
  note i_bound =  i < length (l#ls)
  note ith = (l#ls)!i = (p,Read volatile a t#is,θ,sb,𝒟,𝒪,)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,Read volatile a t#is,θ,sb,𝒟,𝒪,)"
      by simp
    thus ?thesis 
      by (simp add: 0 flush_append_Readsb del: fun_upd_apply )
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l,l)"
      by (cases l)
    from i_bound ith
    have "flush_all_until_volatile_write
      (ls[n := (p,is , θ(tv), sb @ [Readsb volatile a t v],𝒟',𝒪',ℛ') ]) 
      (flush (takeWhile (Not  is_volatile_Writesb) sbl) m) =
      flush_all_until_volatile_write ls (flush (takeWhile (Not  is_volatile_Writesb) sbl) m)"
      apply -
      apply (rule Cons.hyps)
      apply (auto simp add: Suc l)
      done
    
    then
    show ?thesis
      by (simp add: Suc l del: fun_upd_apply)
  qed
qed

lemma flush_all_until_volatile_write_append_Ghost_commute:
  "i m. i < length ts; ts!i=(p,is,θ,sb,𝒟,𝒪,)
        flush_all_until_volatile_write (ts[i := (p',is',θ', sb@[Ghostsb A L R W], 𝒟', 𝒪',ℛ')]) m
       = flush_all_until_volatile_write ts m"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons l ts)
  note i_bound =  i < length (l#ts)
  note ith = (l#ts)!i = (p,is,θ,sb,𝒟,𝒪,)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,is,θ,sb,𝒟,𝒪,)"
      by simp
    thus ?thesis 
      by (simp add: 0 flush_append_Ghostsb del: fun_upd_apply)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l,l)"
      by (cases l)

    from i_bound ith
    have "flush_all_until_volatile_write 
              (ts[n := (p',is',θ', sb@[Ghostsb A L R W], 𝒟', 𝒪',ℛ')])
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m) =
         flush_all_until_volatile_write ts
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m)"
      apply -
      apply (rule Cons.hyps)
      apply (auto simp add: Suc l)
      done

    then show ?thesis
      by (simp add: Suc l)
  qed
qed


lemma update_commute:
assumes g_unchanged: "a m. a  G  g m a = m a"
assumes g_independent: "a m. a  G  g (f m) a = g m a"
assumes f_unchanged: "a m. a  F  f m a = m a"
assumes f_independent: "a m. a  F  f (g m) a = f m a"
assumes disj: "G  F = {}"
shows "f (g m) = g (f m)"
proof 
  fix a
  show "f (g m) a = g (f m) a"
  proof (cases "a  G")
    case True
    with disj have a_notin_F: "a  F"
      by blast
    from f_unchanged [rule_format, OF a_notin_F, of "g m"]
    have "f (g m) a = g m a" .
    also
    from g_independent [rule_format, OF True]
    have " = g (f m) a" by simp
    finally show ?thesis .
  next
    case False
    note a_notin_G = this
    show ?thesis
    proof (cases "a  F")
      case True
      from f_independent [rule_format, OF True]
      have "f (g m) a = f m a" by simp
      also
      from g_unchanged [rule_format, OF a_notin_G]
      have " = g (f m) a"
	by simp
      finally show ?thesis .
    next
      case False
      from f_unchanged [rule_format, OF False]
      have "f (g m) a = g m a".
      also
      from g_unchanged [rule_format, OF a_notin_G]
      have " = m a" .
      also       
      from f_unchanged [rule_format, OF False]
      have " = f m a" by simp
      also
      from g_unchanged [rule_format, OF a_notin_G]
      have " = g (f m) a"
	by simp
      finally show ?thesis .
    qed
  qed
qed
      
      
lemma update_commute':
assumes g_unchanged: "a m. a  G  g m a = m a"
assumes g_independent: "a m1 m2. a  G  g m1 a = g m2 a"
assumes f_unchanged: "a m. a  F  f m a = m a"
assumes f_independent: "a m1 m2. a  F  f m1 a = f m2 a"
assumes disj: "G  F = {}"
shows "f (g m) = g (f m)"
proof -
  from g_independent have g_ind': "a m. a  G  g (f m) a = g m a" by blast
  from f_independent have f_ind': "a m. a  F  f (g m) a = f m a" by blast
  from update_commute [OF g_unchanged g_ind' f_unchanged f_ind' disj]
  show ?thesis .
qed

lemma flush_unchanged_addresses: "m. a  outstanding_refs is_Writesb sb  flush sb m a = m a"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons r sb)
  note a_notin = a  outstanding_refs is_Writesb (r#sb)
  show ?case
  proof (cases r)
    case (Writesb volatile a' sop v)
    from a_notin obtain neq_a_a': "aa'" and a_notin': "a  outstanding_refs is_Writesb sb"
      by (simp add: Writesb)
    from Cons.hyps [OF a_notin', of "m(a':=v)"] neq_a_a'
    show ?thesis
      apply (simp add: Writesb del: fun_upd_apply)
      apply simp
      done
  next
    case (Readsb volatile a' t v)
    from a_notin obtain a_notin': "a  outstanding_refs is_Writesb sb"
      by (simp add: Readsb)
    from Cons.hyps [OF a_notin', of "m"] 
    show ?thesis
      by (simp add: Readsb)
  next
    case Progsb with Cons show ?thesis by simp
  next
    case Ghostsb with Cons show ?thesis by simp
  qed
qed

lemma flushed_values_mem_independent:
  "m m' a. a  outstanding_refs is_Writesb sb   flush sb m' a = flush sb m a"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons r sb)
  show ?case
  proof (cases r)
    case (Writesb volatile a' sop' v')
    have "flush sb (m'(a' := v')) a' = flush sb (m(a' := v')) a'"
    proof (cases "a'  outstanding_refs is_Writesb sb")
      case True
      from Cons.hyps [OF this]
      show ?thesis .
    next
      case False
      from flush_unchanged_addresses [OF False]
      show ?thesis
	by simp
    qed
    with Cons.hyps Cons.prems
    show ?thesis
      by (auto simp add: Writesb)
  next
    case Readsb thus ?thesis using Cons
      by auto
  next
    case Progsb thus ?thesis using Cons
      by auto
  next
    case Ghostsb thus ?thesis using Cons
      by auto
  qed
qed

lemma flush_all_until_volatile_write_unchanged_addresses:
  "m. a  ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Writesb 
                            (takeWhile (Not  is_volatile_Writesb) sb)) ` set ls) 
       flush_all_until_volatile_write ls m a = m a"
proof (induct ls)
  case Nil thus ?case by simp
next
  case (Cons l ls)
  obtain p "is" 𝒪  𝒟 xs sb where l: "l=(p,is,xs,sb,𝒟,𝒪,)"
    by (cases l)
  note a   ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Writesb 
                            (takeWhile (Not  is_volatile_Writesb) sb)) ` set (l#ls))
  then obtain
    a_notin_sb: "a  outstanding_refs is_Writesb 
                            (takeWhile (Not  is_volatile_Writesb) sb)" and
    a_notin_ls: "a   ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Writesb 
                            (takeWhile (Not  is_volatile_Writesb) sb)) ` set ls)"
    by (auto simp add: l)

  
  from Cons.hyps [OF a_notin_ls]
  have "flush_all_until_volatile_write ls (flush (takeWhile (Not  is_volatile_Writesb) sb) m) a 
        = 
        (flush (takeWhile (Not  is_volatile_Writesb) sb) m) a".

  also

  from flush_unchanged_addresses [OF a_notin_sb]
  have "(flush (takeWhile (Not  is_volatile_Writesb) sb) m) a = m a".
  finally
  show ?case
    by (simp add: l)
qed

lemma  notin_outstanding_non_volatile_takeWhile_lem:
  "a  outstanding_refs (Not  is_volatile) sb
        
        a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sb)"
apply (induct sb)
apply (auto simp add: is_Writesb_def split: if_split_asm memref.splits)
done

lemma  notin_outstanding_non_volatile_takeWhile_lem':
  "a  outstanding_refs is_non_volatile_Writesb sb
        
        a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sb)"
apply (induct sb)
apply (auto simp add: is_Writesb_def split: if_split_asm memref.splits)
done

lemma notin_outstanding_non_volatile_takeWhile_Un_lem':
"a   ((λ(_,_,_,sb,_,_,_). outstanding_refs (Not  is_volatile) sb) ` set ls)
  a   ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Writesb 
                            (takeWhile (Not  is_volatile_Writesb) sb)) ` set ls)"
proof (induct ls)
  case Nil thus ?case by simp
next
  case (Cons l ls)
  obtain p "is" 𝒪  𝒟 xs sb where l: "l=(p,is,xs,sb,𝒟,𝒪,)"
    by (cases l)

  from Cons.prems
  obtain 
    a_notin_sb: "a  outstanding_refs (Not  is_volatile) sb" and
    a_notin_ls: "a   ((λ(_,_,_,sb,_,_,_). outstanding_refs (Not  is_volatile) sb) ` set ls)"
    by (force simp add: l simp del: o_apply) 
  from notin_outstanding_non_volatile_takeWhile_lem [OF a_notin_sb]
   Cons.hyps [OF a_notin_ls]
  show ?case
    by (auto simp add: l simp del: o_apply)
qed

lemma flush_all_until_volatile_write_unchanged_addresses':
  assumes  notin: "a   ((λ(_,_,_,sb,_,_,_). outstanding_refs (Not  is_volatile) sb) ` set ls)"
  shows "flush_all_until_volatile_write ls m a = m a"
using notin_outstanding_non_volatile_takeWhile_Un_lem' [OF notin]
by (auto intro: flush_all_until_volatile_write_unchanged_addresses)

lemma flush_all_until_volatile_wirte_mem_independent:
  "m m'. a   ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Writesb 
                     (takeWhile (Not  is_volatile_Writesb) sb)) ` set ls) 
          flush_all_until_volatile_write ls m' a = flush_all_until_volatile_write ls m a"
proof (induct ls)
  case Nil thus ?case by simp
next
  case (Cons l ls)
  obtain p "is" 𝒪  𝒟 xs sb where l: "l=(p,is,xs,sb,𝒟,𝒪,)"
    by (cases l)
  note a_in = a   ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Writesb 
                     (takeWhile (Not  is_volatile_Writesb) sb)) ` set (l#ls))
  show ?case 
  proof (cases "a   ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Writesb 
                     (takeWhile (Not  is_volatile_Writesb) sb)) ` set ls)") 
    case True
    from Cons.hyps [OF this]
    show ?thesis
      by (simp add: l)
  next
    case False
    with a_in
    have "a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sb)"
      by (auto simp add: l)
    from flushed_values_mem_independent [rule_format, OF this]
    have "flush (takeWhile (Not  is_volatile_Writesb) sb) m' a =
          flush (takeWhile (Not  is_volatile_Writesb) sb) m a".
    with flush_all_until_volatile_write_unchanged_addresses [OF False]
    show ?thesis
      by (auto simp add: l)
  qed
qed

lemma flush_all_until_volatile_write_buffered_val_conv: 
  assumes no_volatile_Writesb: "outstanding_refs is_volatile_Writesb sb = {}"
  shows"m i. i < length ls; ls!i = (p,is,xs,sb,𝒟,𝒪,);
               
        j < length ls. i  j 
                (let (_,_,_,sbj,_,_,_) = ls!j 
                 in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))  
      flush_all_until_volatile_write ls m a =
        (case buffered_val sb a of None  m a | Some v  v)"
proof (induct ls)
  case Nil thus ?case
    by simp
next
  case (Cons l ls)
  note i_bound =  i < length (l#ls)
  note ith = (l#ls)!i = (p,is,xs,sb,𝒟,𝒪,)
  note notin = j < length (l#ls). i  j 
                (let (_,_,_,sbj,_,_,_) = (l#ls)!j 
                 in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,is,xs,sb,𝒟,𝒪,)"
      by simp
    from no_volatile_Writesb have take_all: "takeWhile (Not  is_volatile_Writesb) sb = sb"
      by (auto simp add: outstanding_refs_conv)

    have "a  ((λ(_,_, _, sb, _,_,_).
            outstanding_refs is_Writesb
             (takeWhile (Not  is_volatile_Writesb) sb)) ` set ls)" (is "a  ?LS")
    proof 
      assume "a  ?LS" 
      from in_Union_image_nth_conv [OF this]
      obtain j pj "isj" "𝒪j" j "𝒟j" "xsj" "sbj" where 
	j_bound: "j < length ls" and
	jth: "ls!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)" and
	a_in_j: "a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	by fastforce
      from a_in_j obtain v' sop' A L R W where "Writesb False a sop' v' A L R W set (takeWhile (Not  is_volatile_Writesb) sbj)" 
  apply (clarsimp simp add: outstanding_refs_conv )
  subgoal for x
	apply (case_tac x)
	apply    clarsimp
	apply    (frule set_takeWhileD) 
	apply auto
	done
  done
      with notin [rule_format, of "Suc j"] j_bound jth
      show False
	by (force simp add: 0  outstanding_refs_conv is_non_volatile_Writesb_def 
	  split: memref.splits)
    qed
    from flush_all_until_volatile_write_unchanged_addresses [OF this]
    have "flush_all_until_volatile_write ls (flush sb m) a = (flush sb m) a"
      by (simp add: take_all)
    then 
    show ?thesis 
      by (simp add: 0 l take_all flush_buffered_val_conv)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l xsl sbl where l: "l = (pl,isl,xsl,sbl,𝒟l,𝒪l,l )"
      by (cases l)

    from i_bound ith notin
    have "flush_all_until_volatile_write ls
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m) a
          = (case buffered_val sb a of None  
               (flush (takeWhile (Not  is_volatile_Writesb) sbl) m) a | Some v  v)"
      apply -
      apply (rule Cons.hyps)
      apply (force simp add: Suc Let_def simp del: o_apply)+
      done

    moreover
    from notin [rule_format, of 0] l
    have "a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbl)"
      by (auto simp add: Let_def outstanding_refs_conv Suc )
    then
    have "a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbl)" 
      apply (clarsimp simp add: outstanding_refs_conv is_Writesb_def split: memref.splits dest: set_takeWhileD)
      apply (frule set_takeWhileD)
      apply force
      done

    from flush_unchanged_addresses [OF this]
    have "(flush (takeWhile (Not  is_volatile_Writesb) sbl) m) a = m a" .

    ultimately
    show ?thesis
      by (simp add: Suc l split: option.splits)
  qed
qed


context program
begin

abbreviation sb_concurrent_step ::
  "('p,'p store_buffer,'dirty,'owns,'rels,'shared) global_config  ('p,'p store_buffer,'dirty,'owns,'rels,'shared) global_config  bool"
    ("_ sb _" [60,60] 100)
where
  "sb_concurrent_step  
     computation.concurrent_step sb_memop_step store_buffer_step program_step (λp p' is sb. sb)"

term "x sb Y"

abbreviation (in program) sb_concurrent_steps::
  "('p,'p store_buffer,'dirty,'owns,'rels,'shared) global_config  ('p,'p store_buffer,'dirty,'owns,'rels,'shared) global_config  bool"
    ("_ sb* _" [60,60] 100)
where
"sb_concurrent_steps  sb_concurrent_step^**"

term "x sb* Y"

abbreviation sbh_concurrent_step ::
  "('p,'p store_buffer,bool,owns,rels,shared) global_config  ('p,'p store_buffer,bool,owns,rels,shared) global_config  bool"
    ("_ sbh _" [60,60] 100)
where
  "sbh_concurrent_step  
     computation.concurrent_step sbh_memop_step flush_step program_step 
      (λp p' is sb. sb @ [Progsb p p' is] )"

term "x sbh Y"

abbreviation sbh_concurrent_steps::
  "('p,'p store_buffer,bool,owns,rels,shared) global_config  ('p,'p store_buffer,bool,owns,rels,shared) global_config  bool"
    ("_ sbh* _" [60,60] 100)
where
"sbh_concurrent_steps  sbh_concurrent_step^**"

term "x sbh* Y"
end 

lemma instrs_append_Readsb:
  "instrs (sb@[Readsb volatile a t v]) = instrs sb @ [Read volatile a t]"
  by (induct sb) (auto split: memref.splits)

lemma instrs_append_Writesb:
  "instrs (sb@[Writesb volatile a sop v A L R W]) = instrs sb @ [Write volatile a sop A L R W]"
  by (induct sb) (auto split: memref.splits)

lemma instrs_append_Ghostsb:
  "instrs (sb@[Ghostsb A L R W]) = instrs sb @ [Ghost A L R W]"
  by (induct sb) (auto split: memref.splits)


lemma prog_instrs_append_Ghostsb:
  "prog_instrs (sb@[Ghostsb A L R W]) = prog_instrs sb"
  by (induct sb) (auto split: memref.splits)

lemma prog_instrs_append_Readsb:
  "prog_instrs (sb@[Readsb volatile a t v]) = prog_instrs sb "
  by (induct sb) (auto split: memref.splits)

lemma prog_instrs_append_Writesb:
  "prog_instrs (sb@[Writesb volatile a sop v A L R W]) = prog_instrs sb"
  by (induct sb) (auto split: memref.splits)

lemma hd_prog_append_Readsb:
  "hd_prog p (sb@[Readsb volatile a t v]) = hd_prog p sb"
  by (induct sb) (auto split: memref.splits)

lemma hd_prog_append_Writesb:
  "hd_prog p (sb@[Writesb volatile a sop v A L R W]) = hd_prog p sb"
  by (induct sb) (auto split: memref.splits)

lemma flush_update_other: "m. a  outstanding_refs (Not  is_volatile) sb 
        outstanding_refs (is_volatile_Writesb) sb = {} 
       flush sb (m(a:=v)) = (flush sb m)(a := v)"
  by (induct sb)
     (auto split: memref.splits if_split_asm simp add: fun_upd_twist)

lemma flush_update_other': "m. a  outstanding_refs (is_non_volatile_Writesb) sb 
        outstanding_refs (is_volatile_Writesb) sb = {} 
       flush sb (m(a:=v)) = (flush sb m)(a := v)"
  by (induct sb)
     (auto split: memref.splits if_split_asm simp add: fun_upd_twist)

lemma flush_update_other'': "m. a  outstanding_refs (is_non_volatile_Writesb) sb 
        a  outstanding_refs (is_volatile_Writesb) sb 
       flush sb (m(a:=v)) = (flush sb m)(a := v)"
  by (induct sb)
     (auto split: memref.splits if_split_asm simp add: fun_upd_twist)

lemma flush_all_until_volatile_write_update_other:     
"m. j < length ts. 
                (let (_,_,_,sbj,_,_,_) = ts!j 
                 in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)) 
   
  flush_all_until_volatile_write ts (m(a := v)) =
    (flush_all_until_volatile_write ts m)(a := v)"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons t ts)
  note notin = j < length (t#ts). 
                (let (_,_,_,sbj,_,_,_) = (t#ts)!j 
                 in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))
  hence notin': "j < length ts. 
                (let (_,_,_,sbj,_,_,_) = ts!j 
                 in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))"
    by auto

  obtain pl "isl" 𝒪l l 𝒟l xsl sbl where t: "t = (pl,isl,xsl,sbl,𝒟l,𝒪l,l)"
    by (cases t)

  have no_write: 
    "outstanding_refs (is_volatile_Writesb) (takeWhile (Not  is_volatile_Writesb) sbl) = {}"
    by (auto simp add: outstanding_refs_conv dest: set_takeWhileD)

  from notin [rule_format, of 0] t
  have a_notin: 
    "a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbl)"
    by (auto )

  from flush_update_other' [OF a_notin no_write]
  have "(flush (takeWhile (Not  is_volatile_Writesb) sbl) (m(a := v))) =
          (flush (takeWhile (Not  is_volatile_Writesb) sbl) m)(a := v)".
  with Cons.hyps [OF notin', of "(flush (takeWhile (Not  is_volatile_Writesb) sbl) m)"]
  show ?case
    by (simp add: t del: fun_upd_apply)
qed

lemma flush_all_until_volatile_write_append_non_volatile_write_commute: 
  assumes no_volatile_Writesb: "outstanding_refs is_volatile_Writesb sb = {}" 
  shows "m i. i < length ts; ts!i = (p,is,xs,sb,𝒟,𝒪,);
      j < length ts. i  j 
                (let (_,_,_,sbj,_,_,_) = ts!j 
                 in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)) 
    flush_all_until_volatile_write (ts[i := (p',is', xs, sb @ [Writesb False a sop v A L R W],𝒟', 𝒪,ℛ')]) m =
    (flush_all_until_volatile_write ts m)(a := v)"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons t ts)
  note i_bound =  i < length (t#ts)
  note ith = (t#ts)!i = (p,is,xs,sb,𝒟,𝒪,)
  note notin = j < length (t#ts). i  j 
                (let (_,_,_,sbj,_,_,_) = (t#ts)!j 
                 in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))
  show ?case
  proof (cases i)
    case 0
    from ith 0 have t: "t = (p,is,xs,sb,𝒟,𝒪,)"
      by simp
    from no_volatile_Writesb have take_all: "takeWhile (Not  is_volatile_Writesb) sb = sb"
      by (auto simp add: outstanding_refs_conv)

    from no_volatile_Writesb 
    have take_all': "takeWhile (Not  is_volatile_Writesb) (sb @ [Writesb False a sop v A L R W]) = 
            (sb @ [Writesb False a sop v A L R W])"
      by (auto simp add: outstanding_refs_conv)
    from notin 
    have "j < length ts. 
                (let (_,_,_,sbj,_,_,_) = ts!j 
                 in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))"
      by (auto simp add: 0)

    from flush_all_until_volatile_write_update_other [OF this]
    show ?thesis 
      by (simp add: 0 t take_all' take_all flush_append_write del: fun_upd_apply)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l xsl sbl where t: "t = (pl,isl,xsl,sbl,𝒟l,𝒪l,l)"
      by (cases t)
    from i_bound ith notin 
    have "flush_all_until_volatile_write
            (ts[n := (p',is',xs, sb @ [Writesb False a sop v A L R W], 𝒟', 𝒪,ℛ')])
            (flush (takeWhile (Not  is_volatile_Writesb) sbl) m) =
          (flush_all_until_volatile_write ts
              (flush (takeWhile (Not  is_volatile_Writesb) sbl) m))
              (a := v)"
      apply -
      apply (rule Cons.hyps) 
      apply (auto simp add: Suc simp del: o_apply)
      done

    then
    show ?thesis
      by (simp add: t Suc del: fun_upd_apply)
  qed
qed

lemma flush_all_until_volatile_write_append_unflushed: 
  assumes volatile_Writesb: "¬ outstanding_refs is_volatile_Writesb sb = {}" 
  shows "m i. i < length ts; ts!i = (p,is,xs,sb,𝒟,𝒪,) 
    flush_all_until_volatile_write (ts[i := (p',is', xs, sb @ sbx,𝒟', 𝒪,ℛ')]) m =
    (flush_all_until_volatile_write ts m)"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons l ts)
  note i_bound =  i < length (l#ts)
  note ith = (l#ts)!i = (p,is,xs,sb,𝒟,𝒪,)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,is,xs,sb,𝒟,𝒪,)"
      by simp
    from volatile_Writesb
    obtain r where r_in: "r  set sb" and volatile_r: "is_volatile_Writesb r"
      by (auto simp add: outstanding_refs_conv)
    from takeWhile_append1 [OF r_in, of "(Not  is_volatile_Writesb)" ] volatile_r

    have "(flush (takeWhile (Not  is_volatile_Writesb) (sb @ sbx)) m) =
          (flush (takeWhile (Not  is_volatile_Writesb) sb ) m)"
      by auto
    then
    show ?thesis
      by (simp add: 0 l)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l xsl sbl where l: "l = (pl,isl,xsl,sbl,𝒟l,𝒪l,l)"
      by (cases l)

    from Cons.hyps [of n] i_bound ith
    show ?thesis
      by (simp add: l Suc)
  qed
qed

lemma flush_all_until_volatile_nth_update_unused: 
  shows "m i. i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,) 
    flush_all_until_volatile_write (ts[i := (p',is',θ', sb, 𝒟', 𝒪',ℛ')]) m =
    (flush_all_until_volatile_write ts m)"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons l ts)
  note i_bound =  i < length (l#ts)
  note ith = (l#ts)!i = (p,is,θ,sb,𝒟,𝒪,)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,is,θ,sb,𝒟,𝒪,)"
      by simp
    show ?thesis
      by (simp add: 0 l)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l,l)"
      by (cases l)

    from Cons.hyps [of n] i_bound ith
    show ?thesis
      by (simp add: l Suc)
  qed
qed

lemma flush_all_until_volatile_write_append_volatile_write_commute:  
  assumes no_volatile_Writesb: "outstanding_refs is_volatile_Writesb sb = {}" 
  shows "m i. i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,) 
    flush_all_until_volatile_write
     (ts[i := (p',is', θ, sb @ [Writesb True a sop v A L R W],𝒟', 𝒪,ℛ')]) m
   = flush_all_until_volatile_write ts m"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons l ts)
  note i_bound =  i < length (l#ts)
  note ith = (l#ts)!i = (p,is,θ,sb,𝒟,𝒪,)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,is,θ,sb,𝒟,𝒪,)"
      by simp
    from no_volatile_Writesb
    have s1: "takeWhile (Not  is_volatile_Writesb) sb  = sb"
      by (auto simp add: outstanding_refs_conv)

    from no_volatile_Writesb
    have s2: "(takeWhile (Not  is_volatile_Writesb) (sb @ [Writesb True a sop v A L R W])) = sb"
      by (auto simp add: outstanding_refs_conv)

    show ?thesis
      by (simp add: 0 l s1 s2)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l,l)"
      by (cases l)

    from Cons.hyps [of n] i_bound ith
    show ?thesis
      by (simp add: l Suc)
  qed
qed

lemma reads_consistent_update: 
  "pending_write 𝒪 m. reads_consistent pending_write 𝒪 m sb  
       a  outstanding_refs (Not  is_volatile) sb       
       reads_consistent pending_write 𝒪 (m(a := v)) sb"
apply (induct sb)
apply simp
apply  (clarsimp split: memref.splits if_split_asm
         simp add: fun_upd_twist)
subgoal for sb 𝒪 m x11 addr val A R pending_write
apply (case_tac "a=addr")
apply simp
apply (fastforce simp add: fun_upd_twist)
done
done

lemma (in program) history_consistent_hd_prog: "p. history_consistent θ p' xs
 history_consistent θ (hd_prog p xs) xs"
apply (induct xs)
apply  simp
apply (auto split: memref.splits option.splits)
done

locale valid_program = program +
  fixes valid_prog
  assumes valid_prog_inv: "θp p (p',is'); valid_prog p  valid_prog p'"

lemma (in valid_program) history_consistent_appendD: 
  "θ ys p. sop  write_sops xs. valid_sop sop 
                read_tmps xs  read_tmps ys = {}  
          history_consistent θ p (xs@ys)  
           (history_consistent (θ|` (dom θ - read_tmps ys)) p xs  
            history_consistent θ (last_prog p xs) ys 
            read_tmps ys  (fst ` write_sops xs) = {})" 
proof (induct xs)
  case Nil thus ?case
    by auto
next
  case (Cons x xs)
  note valid_sops = sopwrite_sops (x # xs). valid_sop sop
  note read_tmps_dist = ‹read_tmps (x#xs)  read_tmps ys = {}
  note consis = ‹history_consistent θ p ((x#xs)@ys)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v)
    obtain D f where sop: "sop=(D,f)"
      by (cases sop) 
    from consis obtain 
      D_tmps: "D  dom θ" and
      f_v: "f θ = v" and
      D_read_tmps: "D  read_tmps (xs @ ys) = {}" and
      consis': "history_consistent θ p (xs @ ys)" 
      by (simp add: Writesb sop)
    from valid_sops obtain 
      valid_Df: "valid_sop (D,f)" and
      valid_sops': "sopwrite_sops xs. valid_sop sop"
      by (auto simp add: Writesb sop)
    from valid_Df
    interpret valid_sop "(D,f)" .
    from read_tmps_dist have read_tmps_dist': "read_tmps xs  read_tmps ys = {}"
      by (simp add: Writesb)


    from D_read_tmps have D_ys: "D  read_tmps ys = {}"
      by (auto simp add: read_tmps_append)
    with D_tmps have D_subset: "D  dom θ - read_tmps ys"
      by auto
    moreover
    
    from valid_sop [OF refl D_tmps]
    have "f θ = f (θ |` D)".
    moreover
    let ?θ' = "θ |` (dom θ - read_tmps ys)"
    from D_subset
    have "?θ' |` D = θ |` D" 
      apply -
      apply (rule ext)
      by (auto simp add: restrict_map_def)
    moreover
    from D_subset
    have D_tmps': "D  dom ?θ'"
      by auto
    ultimately 
    have f_v': "f ?θ' = v"
      using valid_sop [OF refl D_tmps'] f_v
      by simp
    from D_read_tmps
    have "D  read_tmps xs = {}"
      by (auto simp add: read_tmps_append)
    with Cons.hyps [OF valid_sops' read_tmps_dist' consis'] D_tmps D_subset f_v' D_ys
    show ?thesis
      by (auto simp add: Writesb sop)
  next
    case (Readsb volatile a t v)
    from consis obtain 
      tmps_t: "θ t = Some v" and
      consis': "history_consistent θ p (xs @ ys)"
      by (simp add: Readsb split: option.splits)

    from read_tmps_dist
    obtain t_ys: "t  read_tmps ys" and read_tmps_dist': "read_tmps xs  read_tmps ys = {}"
      by (auto simp add: Readsb)
    from valid_sops have valid_sops': "sopwrite_sops xs. valid_sop sop"
      by (auto simp add: Readsb)
    from t_ys tmps_t
    have "(θ |` (dom θ - read_tmps ys)) t = Some v"
      by (auto simp add: restrict_map_def domIff)
    with Cons.hyps [OF valid_sops' read_tmps_dist' consis']

    show ?thesis
      by (auto simp add: Readsb)
  next
    case (Progsb p1 p2 mis)
    from consis obtain p1_p: "p1 = p" and
     prog_step: "θ |` (dom θ - read_tmps (xs @ ys)) p1 p (p2, mis)" and
     consis': "history_consistent θ p2 (xs @ ys)"
      by (auto simp add: Progsb)

    let ?θ' = "θ |` (dom θ - read_tmps ys)"
    have eq: "?θ' |` (dom ?θ' - read_tmps xs) = θ |` (dom θ - read_tmps (xs @ ys))"
      apply (rule ext)
      apply (auto simp add: read_tmps_append restrict_map_def domIff split: if_split_asm)
      done

    from valid_sops have valid_sops': "sopwrite_sops xs. valid_sop sop"
      by (auto simp add: Progsb)
    from read_tmps_dist
    obtain read_tmps_dist': "read_tmps xs  read_tmps ys = {}"
      by (auto simp add: Progsb)
    from Cons.hyps [OF valid_sops' read_tmps_dist' consis'] p1_p prog_step eq
    show ?thesis
      by (simp add: Progsb)
  next
    case Ghostsb
    with Cons show ?thesis
      by auto
  qed
qed

lemma (in valid_program) history_consistent_appendI: 
  "θ ys p. sop  write_sops xs. valid_sop sop 
  history_consistent (θ|` (dom θ - read_tmps ys)) p xs 
 history_consistent θ (last_prog p xs) ys 
 read_tmps ys  (fst ` write_sops xs) = {}  valid_prog p 
           history_consistent θ p (xs@ys)" 
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x xs)
  note valid_sops = sopwrite_sops (x # xs). valid_sop sop
  note consis_xs = ‹history_consistent (θ |` (dom θ - read_tmps ys)) p (x # xs)
  note consis_ys = ‹history_consistent θ (last_prog p (x # xs)) ys
  note dist = ‹read_tmps ys  (fst ` write_sops (x # xs)) = {}
  note valid_p = valid_prog p
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v)
    obtain D f where sop: "sop=(D,f)"
      by (cases sop) 
    from consis_xs obtain 
      D_tmps: "D  dom θ - read_tmps ys" and
      f_v: "f (θ |` (dom θ - read_tmps ys)) = v" (is "f  = v") and
      D_read_tmps: "D  read_tmps xs = {}" and
      consis': "history_consistent (θ |` (dom θ - read_tmps ys)) p xs" 
      by (simp add: Writesb sop)

    from D_tmps D_read_tmps 
    have "D  read_tmps (xs @ ys) = {}"
      by (auto simp add: read_tmps_append)
    moreover
    from D_tmps have D_tmps': "D  dom θ"
      by auto
    moreover 
    from valid_sops obtain 
      valid_Df: "valid_sop (D,f)" and
      valid_sops': "sopwrite_sops xs. valid_sop sop"
      by (auto simp add: Writesb sop)
    from valid_Df
    interpret valid_sop "(D,f)" .

    from D_tmps
    have tmps_eq: "θ |` ((dom θ - read_tmps ys)  D) = θ |` D"
      apply -
      apply (rule ext) 
      apply (auto simp add: restrict_map_def)
      done
    from D_tmps
    have "f  = f ( |` D)"
      apply -
      apply (rule valid_sop [OF refl ])
      apply auto
      done
    with valid_sop [OF refl D_tmps'] f_v D_tmps

    have "f θ = v"
      by (clarsimp simp add: tmps_eq)
    moreover
    from consis_ys have consis_ys': "history_consistent θ (last_prog p xs) ys"
      by (auto simp add: Writesb)

    from dist have dist': "read_tmps ys  (fst ` write_sops xs) = {}"
      by (auto simp add: Writesb)

    moreover note Cons.hyps [OF valid_sops' consis' consis_ys' dist' valid_p]

    ultimately show ?thesis
      by (simp add: Writesb sop)
  next
    case (Readsb volatile a t v)
    from consis_xs obtain
      t_v: "(θ |` (dom θ - read_tmps ys)) t = Some v" and
      consis_xs': "history_consistent (θ |` (dom θ - read_tmps ys)) p xs"
      by (clarsimp simp add: Readsb split: option.splits)
    from t_v have "θ t = Some v"
      by (auto simp add: restrict_map_def split: if_split_asm)
    moreover
    from valid_sops obtain 
      valid_sops': "sopwrite_sops xs. valid_sop sop"
      by (auto simp add: Readsb)
    from consis_ys have consis_ys': "history_consistent θ (last_prog p xs) ys"
      by (auto simp add: Readsb)
    from dist have dist': "read_tmps ys  (fst ` write_sops xs) = {}"
      by (auto simp add: Readsb)

    note Cons.hyps [OF valid_sops' consis_xs' consis_ys' dist' valid_p]
    ultimately
    show ?thesis
      by (simp add: Readsb)
  next
    case (Progsb p1 p2 mis)
    let  = "θ |` (dom θ - read_tmps ys)"
    from consis_xs  obtain 
      p1_p: "p1 = p" and
      prog_step: " |` (dom  - read_tmps xs) p1 p (p2, mis)" and
      consis': "history_consistent  p2 xs"
      by (auto simp add: Progsb)
    
    (*let ?θ' = "θ |` (dom θ - read_tmps ys)"*)
    have eq: " |` (dom  - read_tmps xs) = θ |` (dom θ - read_tmps (xs @ ys))"
      apply (rule ext)
      apply (auto simp add: read_tmps_append restrict_map_def domIff split: if_split_asm)
      done

    from prog_step eq
    have "θ |` (dom θ - read_tmps (xs @ ys)) p1 p (p2, mis)" by simp
    moreover
    from valid_sops obtain 
      valid_sops': "sopwrite_sops xs. valid_sop sop"
      by (auto simp add: Progsb)
    from consis_ys have consis_ys': "history_consistent θ (last_prog p2 xs) ys"
      by (auto simp add: Progsb)
    from dist have dist': "read_tmps ys  (fst ` write_sops xs) = {}"
      by (auto simp add: Progsb)

    note Cons.hyps [OF valid_sops' consis' consis_ys' dist' valid_prog_inv [OF prog_step valid_p [simplified p1_p [symmetric]]]]
    ultimately
    show ?thesis
      by (simp add: Progsb p1_p)
  next
    case Ghostsb
    with Cons show ?thesis
      by auto
  qed
qed

lemma (in valid_program) history_consistent_append_conv: 
  "θ ys p. sop  write_sops xs. valid_sop sop 
                read_tmps xs  read_tmps ys = {}  valid_prog p 
          history_consistent θ p (xs@ys) = 
           (history_consistent (θ|` (dom θ - read_tmps ys)) p xs  
            history_consistent θ (last_prog p xs) ys 
            read_tmps ys  (fst ` write_sops xs) = {})"
apply rule
apply  (rule history_consistent_appendD,assumption+)
apply (rule history_consistent_appendI)
apply auto
done

lemma instrs_takeWhile_dropWhile_conv:
  "instrs xs = instrs (takeWhile P xs) @ instrs (dropWhile P xs)"
by (induct xs) (auto split: memref.splits)



lemma (in program) history_consistent_hd_prog_p: 
  "p. history_consistent θ p xs  p = hd_prog p xs"
  by (induct xs) (auto split: memref.splits option.splits)

lemma instrs_append: "ys. instrs (xs@ys) = instrs xs @ instrs ys"
  by (induct xs) (auto split: memref.splits)

lemma prog_instrs_append: "ys. prog_instrs (xs@ys) = prog_instrs xs @ prog_instrs ys"
  by (induct xs) (auto split: memref.splits)

lemma prog_instrs_empty: "r  set xs. ¬ is_Progsb r  prog_instrs xs = []"
  by (induct xs) (auto split: memref.splits)

lemma length_dropWhile [termination_simp]: "length (dropWhile P xs)  length xs"
  by (induct xs) auto

lemma prog_instrs_filter_is_Progsb: "prog_instrs (filter (is_Progsb) xs) = prog_instrs xs"
  by (induct xs) (auto split: memref.splits)


lemma Cons_to_snoc: "x. ys y. (x#xs) = (ys@[y])"
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x1 xs)
  from Cons [of x1] obtain ys y where "x1#xs = ys @ [y]"
    by auto
  then
  show ?case
    by simp
qed

lemma causal_program_history_Read:
  assumes causal_Read: "causal_program_history (Read volatile a t # issb) sb" 
  shows "causal_program_history issb (sb @ [Readsb volatile a t v])"
proof
  fix sb1 sb2
  assume sb: "sb @ [Readsb volatile a t v] = sb1 @ sb2"
  from causal_Read
  interpret causal_program_history "Read volatile a t # issb" "sb" .
  show "is. instrs sb2 @ issb = is @ prog_instrs sb2"
  proof (cases sb2)
    case Nil
    thus ?thesis
      by simp
  next
    case (Cons r sb')
    from Cons_to_snoc [of r sb'] Cons obtain ys y where sb2_snoc: "sb2=ys@[y]"
      by auto
    with sb obtain y: "y = Readsb volatile a t v" and sb: "sb = sb1@ys"
      by simp

    from causal_program_history [OF sb] obtain "is" where
      "instrs ys @ Read volatile a t # issb = is @ prog_instrs ys"
      by auto
    then show ?thesis
      by (simp add: sb2_snoc y instrs_append prog_instrs_append)
  qed
qed


lemma causal_program_history_Write:
  assumes causal_Write: "causal_program_history (Write volatile a sop A L R W# issb) sb"
  shows  "causal_program_history issb (sb @ [Writesb volatile a sop v A L R W])"
proof
  fix sb1 sb2
  assume sb: "sb @ [Writesb volatile a sop v A L R W] = sb1 @ sb2"
  from causal_Write
  interpret causal_program_history "Write volatile a sop A L R W# issb" "sb" .
  show "is. instrs sb2 @ issb = is @ prog_instrs sb2"
  proof (cases sb2)
    case Nil
    thus ?thesis
      by simp
  next
    case (Cons r sb')
    from Cons_to_snoc [of r sb'] Cons obtain ys y where sb2_snoc: "sb2=ys@[y]"
      by auto
    with sb obtain y: "y = Writesb volatile a sop v A L R W" and sb: "sb = sb1@ys"
      by simp

    from causal_program_history [OF sb] obtain "is" where
      "instrs ys @ Write volatile a sop A L R W# issb = is @ prog_instrs ys"
      by auto
    then show ?thesis
      by (simp add: sb2_snoc y instrs_append prog_instrs_append)
  qed
qed

lemma causal_program_history_Progsb:
  assumes causal_Write: "causal_program_history issb sb"
  shows  "causal_program_history (issb@mis) (sb @ [Progsb p1 p2 mis])"
proof
  fix sb1 sb2
  assume sb: "sb @ [Progsb p1 p2 mis] = sb1 @ sb2"
  from causal_Write
  interpret causal_program_history "issb" "sb" .
  show "is. instrs sb2 @ (issb@mis) = is @ prog_instrs sb2"
  proof (cases sb2)
    case Nil
    thus ?thesis
      by simp
  next
    case (Cons r sb')
    from Cons_to_snoc [of r sb'] Cons obtain ys y where sb2_snoc: "sb2=ys@[y]"
      by auto
    with sb obtain y: "y = Progsb p1 p2 mis" and sb: "sb = sb1@ys"
      by simp

    from causal_program_history [OF sb] obtain "is" where
      "instrs ys @ (issb @ mis) = is @ prog_instrs (ys@[Progsb p1 p2 mis])"
      by (auto simp add: prog_instrs_append)
    then show ?thesis
      by (simp add: sb2_snoc y instrs_append prog_instrs_append)
  qed
qed

lemma causal_program_history_Ghost:
  assumes causal_Ghostsb: "causal_program_history (Ghost A L R W # issb) sb"
  shows  "causal_program_history issb (sb @ [Ghostsb A L R W])"
proof
  fix sb1 sb2
  assume sb: "sb @ [Ghostsb A L R W] = sb1 @ sb2"
  from causal_Ghostsb
  interpret causal_program_history "Ghost A L R W # issb" "sb" .
  show "is. instrs sb2 @ issb = is @ prog_instrs sb2"
  proof (cases sb2)
    case Nil
    thus ?thesis
      by simp
  next
    case (Cons r sb')
    from Cons_to_snoc [of r sb'] Cons obtain ys y where sb2_snoc: "sb2=ys@[y]"
      by auto
    with sb obtain y: "y = Ghostsb A L R W" and sb: "sb = sb1@ys"
      by simp

    from causal_program_history [OF sb] obtain "is" where
      "instrs ys @ Ghost A L R W # issb = is @ prog_instrs ys"
      by auto
    then show ?thesis
      by (simp add: sb2_snoc y instrs_append prog_instrs_append)
  qed
qed

lemma hd_prog_last_prog_end: "p = hd_prog p sb ; last_prog p sb = psb  p = hd_prog psb sb"
  by (induct sb) (auto split: memref.splits)

lemma hd_prog_idem: "hd_prog (hd_prog p xs) xs = hd_prog p xs"
  by (induct xs) (auto split: memref.splits)

lemma last_prog_idem: "last_prog (last_prog p sb) sb = last_prog p sb"
  by (induct sb) (auto split: memref.splits)


lemma last_prog_hd_prog_append:
  "last_prog (hd_prog psb (sb@sb')) sb =last_prog (hd_prog psb sb') sb"
apply (induct sb)
apply (auto split: memref.splits)
done

lemma last_prog_hd_prog: "last_prog (hd_prog p xs) xs = last_prog p xs"
  by (induct xs) (auto split: memref.splits)


lemma last_prog_append_Readsb: 
  "p. last_prog p (sb @ [Readsb volatile a t v]) = last_prog p sb"
  by (induct sb) (auto split: memref.splits)


lemma last_prog_append_Writesb: 
  "p. last_prog p (sb @ [Writesb volatile a sop v A L R W]) = last_prog p sb"
  by (induct sb) (auto split: memref.splits)


lemma last_prog_append_Progsb:
  "x. last_prog x (sb@[Progsb p p' mis]) = p'"
  by (induct sb) (auto split: memref.splits)

lemma hd_prog_append_Progsb: "hd_prog x (sb @ [Progsb p p' mis]) = hd_prog p sb"
  by (induct sb) (auto split: memref.splits)


lemma hd_prog_last_prog_append_Progsb:
  "p'. hd_prog p' xs = p'  last_prog p' xs = p1  
       hd_prog p' (xs @ [Progsb p1 p2 mis]) = p'"
apply (induct xs)
apply (auto split: memref.splits)
done

lemma hd_prog_append_Ghostsb:
  "hd_prog p (sb@[Ghostsb A  R L W]) = hd_prog p sb"
  by (induct sb) (auto split: memref.splits)

lemma last_prog_append_Ghostsb: 
  "p. last_prog p (sb @ [Ghostsb A L R W]) = last_prog p sb"
  by (induct sb) (auto split: memref.splits)

lemma dropWhile_all_False_conv:  
"x  set xs. ¬ P x  dropWhile P xs = xs"
by (induct xs) auto

lemma dropWhile_append_all_False: 
"y  set ys. ¬ P y  
  dropWhile P (xs@ys) = dropWhile P xs @ ys"
apply (induct xs)
apply (auto simp add: dropWhile_all_False_conv)
done


lemma reads_consistent_append_first:
  "m ys. reads_consistent pending_write 𝒪 m (xs @ ys)  reads_consistent pending_write 𝒪 m xs"
  by (clarsimp simp add: reads_consistent_append)

lemma reads_consistent_takeWhile:
assumes consis: "reads_consistent pending_write 𝒪 m sb" 
shows "reads_consistent pending_write 𝒪 m (takeWhile P sb)"
using reads_consistent_append [where xs="(takeWhile P sb)" and ys="(dropWhile P sb)"] consis
apply (simp add: reads_consistent_append)
done

lemma flush_flush_all_until_volatile_write_Writesb_volatile_commute:
  "i m. i < length ts; ts!i=(p,is,xs,Writesb True a sop v A L R W#sb,𝒟,𝒪,);
        i < length ts. (j < length ts. i  j 
                  (let (_,_,_,sbi,_,_,_) = ts!i;
                      (_,_,_,sbj,_,_,_) = ts!j
                   in outstanding_refs is_Writesb sbi  
                      outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj) = {}));
        j < length ts. i  j 
                (let (_,_,_,sbj,_,_,_) = ts!j in a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))
        
       flush (takeWhile (Not  is_volatile_Writesb) sb)
         ((flush_all_until_volatile_write ts m)(a := v)) =
       flush_all_until_volatile_write (ts[i := (p,is,xs, sb, 𝒟', 𝒪',ℛ')])
         (m(a := v))"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons l ts)
  note i_bound =  i < length (l#ts)
  note ith = (l#ts)!i = (p,is,xs,Writesb True a sop v A L R W#sb,𝒟,𝒪,)
  note disj = i < length (l#ts). (j < length (l#ts). i  j 
                  (let (_,_,_,sbi,_,_,_) = (l#ts)!i;
                      (_,_,_,sbj,_,_,_) = (l#ts)!j
                   in outstanding_refs is_Writesb sbi  
                      outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj) = {}))
  note a_notin = j < length (l#ts). i  j 
                (let (_,_,_,sbj,_,_,_) = (l#ts)!j 
                 in a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,is,xs,Writesb True a sop v A L R W#sb,𝒟,𝒪,)"
      by simp
    have a_notin_ts:
      "a  ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Writesb 
                            (takeWhile (Not  is_volatile_Writesb) sb)) ` set ts)" (is "a  ?U")
    proof 
      assume "a  ?U"
      from in_Union_image_nth_conv [OF this]
      obtain j pj "isj" "𝒪j" j 𝒟j "xsj" "sbj" where 
	j_bound: "j < length ts" and
	jth: "ts!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)" and
	a_in_j: "a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	by fastforce
      from a_notin [rule_format, of "Suc j"] j_bound 0 a_in_j
      show False
	by (auto simp add: jth)
    qed

    from a_notin_ts
    have "(flush_all_until_volatile_write ts m)(a := v) =
                flush_all_until_volatile_write ts (m(a := v))"
      apply -
      apply (rule update_commute' [where F="{a}" and G="?U" and 
	g="flush_all_until_volatile_write ts"])
      apply (auto intro: flush_all_until_volatile_wirte_mem_independent
             flush_all_until_volatile_write_unchanged_addresses)
      done
    
    moreover

    let ?SB = "outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sb)"

    have U_SB_disj: "?U  ?SB = {}"
    proof -
      {
	fix a'
	assume a'_in_U: "a'  ?U"
	have "a'  ?SB"
	proof 
	  assume a'_in_SB: "a'  ?SB"
	  hence a'_in_SB': "a'  outstanding_refs is_Writesb sb"
	    apply (clarsimp simp add: outstanding_refs_conv)
	    apply (drule set_takeWhileD)
      subgoal for x
	    apply (rule_tac x=x in exI)
	    apply (auto simp add: is_Writesb_def split:memref.splits)
	    done
	    done
	  from in_Union_image_nth_conv [OF a'_in_U]
	  obtain j pj "isj" "𝒪j" j 𝒟j "xsj" "sbj" where 
	    j_bound: "j < length ts" and
	    jth: "ts!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)" and
	    a'_in_j: "a'  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	    by fastforce

	  from disj [rule_format, of 0 "Suc j"] 0 j_bound a'_in_SB' a'_in_j jth l
	  show False
	    by auto
	qed
      }
      moreover
      {
	fix a'
	assume a'_in_SB: "a'  ?SB"
	hence a'_in_SB': "a'  outstanding_refs is_Writesb sb"
	    apply (clarsimp simp add: outstanding_refs_conv)
	    apply (drule set_takeWhileD)
	    subgoal for x
	    apply (rule_tac x=x in exI)
	    apply (auto simp add: is_Writesb_def split:memref.splits)
	    done
	    done
	have "a'  ?U"
	proof 
	  assume "a'  ?U"
	  from in_Union_image_nth_conv [OF this]
	  obtain j pj "isj" "𝒪j" j 𝒟j "xsj" "sbj" where 
	    j_bound: "j < length ts" and
	    jth: "ts!j = (pj,isj,xsj,sbj,𝒟j,j,𝒪j)" and
	    a'_in_j: "a'  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	    by fastforce

	  from disj [rule_format, of 0 "Suc j"] j_bound a'_in_SB' a'_in_j jth  l
	  show False
	    by auto
	qed
      }
      ultimately
      show ?thesis by blast
    qed

    have "flush (takeWhile (Not  is_volatile_Writesb) sb)
           (flush_all_until_volatile_write ts (m(a := v))) = 
          flush_all_until_volatile_write ts 
           (flush (takeWhile (Not  is_volatile_Writesb) sb) (m(a := v)))"
      apply (rule update_commute' [where g = "flush_all_until_volatile_write ts ",
             OF _ _ _ _ U_SB_disj])
      apply (auto intro: flush_all_until_volatile_wirte_mem_independent
             flush_all_until_volatile_write_unchanged_addresses
             flush_unchanged_addresses
             flushed_values_mem_independent simp del: o_apply)
      done
      
    ultimately
    have "flush (takeWhile (Not  is_volatile_Writesb) sb)
           ((flush_all_until_volatile_write ts m)(a := v)) =
          flush_all_until_volatile_write ts
           (flush (takeWhile (Not  is_volatile_Writesb) sb) (m(a := v)))"
      by simp

    then show ?thesis 
      by (auto simp add: l 0 o_def simp del: fun_upd_apply)
  next
    case (Suc n)

    obtain pl "isl" 𝒪l l 𝒟j xsl sbl where l: "l = (pl,isl,xsl,sbl,𝒟j,𝒪l,l)"
      by (cases l)

    from i_bound ith disj a_notin
    have  
      "flush (takeWhile (Not  is_volatile_Writesb) sb)
        ((flush_all_until_volatile_write ts
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m))
          (a := v)) =
       flush_all_until_volatile_write (ts[n := (p,is, xs, sb,𝒟', 𝒪',ℛ')])
        ((flush (takeWhile (Not  is_volatile_Writesb) sbl) m)(a := v))"
      apply -
      apply (rule Cons.hyps)
      apply (force simp add: Suc Let_def simp del: o_apply)+
      done

    moreover

    let ?SB = "outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbl)"
    have "a  ?SB"
    proof 
      assume "a  ?SB"
      with a_notin [rule_format, of 0]
      show False
	by (auto simp add: l Suc)
    qed
    then
    have "((flush (takeWhile (Not  is_volatile_Writesb) sbl) m)(a := v)) =
          (flush (takeWhile (Not  is_volatile_Writesb) sbl) (m(a := v)))"
      apply -
      apply (rule update_commute' [where m=m and F="{a}" and G="?SB"])
      apply (auto intro: 
             flush_unchanged_addresses
             flushed_values_mem_independent simp del: o_apply)
      done

    ultimately
    show ?thesis
      by (simp add: l Suc del: fun_upd_apply o_apply)
  qed
qed



   




lemma (in program)
"sb' p. history_consistent θ (hd_prog p (sb@sb')) (sb@sb') 
          last_prog p (sb@sb') = p  
 last_prog (hd_prog p (sb@sb')) sb = hd_prog p sb'"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons r sb1)
  have consis: "history_consistent θ (hd_prog p ((r # sb1) @ sb')) ((r # sb1) @ sb')" 
    by fact
  have last_prog: "last_prog p ((r # sb1) @ sb') = p" by fact
  show ?case
  proof (cases r)
    case Writesb with Cons show ?thesis by auto
  next
    case Readsb with Cons show ?thesis by (auto split: option.splits)
  next
    case (Progsb p1 p2 "is")
    from last_prog have last_prog_p2: "last_prog p2 (sb1 @ sb') = p"
      by (simp add: Progsb)
    from consis obtain consis': "history_consistent θ p2 (sb1 @ sb')"
      by (simp add: Progsb)

    hence "history_consistent θ (hd_prog p2 (sb1 @ sb')) (sb1 @ sb')"
      by (rule history_consistent_hd_prog)
    from Cons.hyps [OF this ]
    have "last_prog p2 sb1 = hd_prog p sb'"
      oops

lemma last_prog_to_last_prog_same: "p'. last_prog p' sb = p  last_prog p sb = p"
  by (induct sb) (auto split: memref.splits)

lemma last_prog_hd_prog_same: "last_prog p' sb = p; hd_prog p' sb = p'  hd_prog p sb = p'"
  by (induct sb) (auto split : memref.splits)

lemma last_prog_hd_prog_last_prog:   
  "last_prog p' (sb@sb') = p  hd_prog p' (sb@sb') = p' 
   last_prog (hd_prog p sb') sb = last_prog p' sb"
apply (induct sb)
apply (simp add: last_prog_hd_prog_same)
apply (auto split : memref.splits)
done

lemma (in program) last_prog_hd_prog_append':
"sb' p. history_consistent θ (hd_prog p (sb@sb')) (sb@sb') 
          last_prog p (sb@sb') = p  
 last_prog (hd_prog p sb') sb = hd_prog p sb'"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons r sb1)
  have consis: "history_consistent θ (hd_prog p ((r # sb1) @ sb')) ((r # sb1) @ sb')" 
    by fact
  have last_prog: "last_prog p ((r # sb1) @ sb') = p" by fact
  show ?case
  proof (cases r)
    case Writesb with Cons show ?thesis by auto
  next
    case Readsb with Cons show ?thesis by (auto split: option.splits)
  next
    case (Progsb p1 p2 "is")
    from last_prog have last_prog_p2: "last_prog p2 (sb1 @ sb') = p"
      by (simp add: Progsb)
    from last_prog_to_last_prog_same [OF this]
    have last_prog_p: "last_prog p (sb1 @ sb') = p".
    from consis obtain consis': "history_consistent θ p2 (sb1 @ sb')"
      by (simp add: Progsb)
    from history_consistent_hd_prog_p [OF consis']
    have hd_prog_p2: "hd_prog p2 (sb1 @ sb') = p2" by simp
    from consis' have "history_consistent θ (hd_prog p (sb1 @ sb')) (sb1 @ sb')"
      by (rule history_consistent_hd_prog)
    from Cons.hyps [OF this last_prog_p]
    have "last_prog (hd_prog p sb') sb1 = hd_prog p sb'".
    moreover
    from last_prog_hd_prog_last_prog [OF last_prog_p2 hd_prog_p2]
    have "last_prog (hd_prog p sb') sb1 = last_prog p2 sb1".
    ultimately
    have "last_prog p2 sb1 = hd_prog p sb'"
      by simp
    thus ?thesis
      by (simp add: Progsb)
  next
    case Ghostsb with Cons show ?thesis by (auto split: option.splits)
  qed
qed

lemma flush_all_until_volatile_write_Writesb_non_volatile_commute:
  "i m. i < length ts; ts!i=(p,is,xs,Writesb False a sop v A L R W#sb,𝒟,𝒪,);
        i < length ts. (j < length ts. i  j 
                  (let (_,_,_,sbi,_,_,_) = ts!i;
                      (_,_,_,sbj,_,_,_) = ts!j
                   in outstanding_refs is_Writesb sbi  
                      outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj) = {}));
        j < length ts. i  j 
                (let (_,_,_,sbj,_,_,_) = ts!j in a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))
        flush_all_until_volatile_write (ts[i := (p,is, xs, sb,𝒟', 𝒪,ℛ')])(m(a := v))  =
               flush_all_until_volatile_write ts m"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons l ts)
  note i_bound =  i < length (l#ts)
  note ith = (l#ts)!i = (p,is,xs,Writesb False a sop v A L R W#sb,𝒟,𝒪,)
  note disj = i < length (l#ts). (j < length (l#ts). i  j 
                  (let (_,_,_,sbi,_,_,_) = (l#ts)!i;
                      (_,_,_,sbj,_,_,_) = (l#ts)!j
                   in outstanding_refs is_Writesb sbi  
                      outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj) = {}))
  note a_notin = j < length (l#ts). i  j 
                (let (_,_,_,sbj,_,_,_) = (l#ts)!j 
    in a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,is,xs,Writesb False a sop v A L R W#sb,𝒟,𝒪,)"
      by simp
    thus ?thesis 
      by (simp add: 0 del: fun_upd_apply)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l xsl sbl where l: "l = (pl,isl,xsl,sbl,𝒟l,𝒪l,l)"
      by (cases l)

    from i_bound ith disj a_notin 
    have
      "flush_all_until_volatile_write (ts[n := (p,is,xs, sb, 𝒟', 𝒪,ℛ')])
          ((flush (takeWhile (Not  is_volatile_Writesb) sbl) m)(a := v)) =
       flush_all_until_volatile_write ts
          (flush (takeWhile (Not  is_volatile_Writesb) sbl) m)"
      apply -
      apply (rule Cons.hyps)
      apply (force simp add: Suc Let_def simp del: o_apply)+
      done

    moreover

    let ?SB = "outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbl)"
    have "a  ?SB"
    proof 
      assume "a  ?SB"
      with a_notin [rule_format, of 0]
      show False
	by (auto simp add: l Suc)
    qed
    then
    have "((flush (takeWhile (Not  is_volatile_Writesb) sbl) m)(a := v)) =
          (flush (takeWhile (Not  is_volatile_Writesb) sbl) (m(a := v)))"
      apply -
      apply (rule update_commute' [where m=m and F="{a}" and G="?SB"])
      apply (auto intro: 
             flush_unchanged_addresses
             flushed_values_mem_independent simp del: o_apply)
      done

    ultimately
    show ?thesis
      by (simp add: l Suc del: fun_upd_apply o_apply)
  qed
qed   

lemma (in program) history_consistent_access_last_read': 
  "p. history_consistent θ p (sb @ [Readsb volatile a t v]) 
        θ t = Some v"
apply (induct sb)
apply (auto  split: memref.splits option.splits)
done

lemma (in program) history_consistent_access_last_read:
  "history_consistent θ p (rev (Readsb volatile a t v # sb))  θ t = Some v"
  by (simp add: history_consistent_access_last_read')

lemma flush_all_until_volatile_write_Readsb_commute:
  "i m. i < length ts; ts!i=(p,is,θ,Readsb volatile a t v#sb,𝒟,𝒪,)
        flush_all_until_volatile_write (ts[i := (p,is,θ, sb, 𝒟', 𝒪,ℛ')]) m
       = flush_all_until_volatile_write ts m"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons l ts)
  note i_bound =  i < length (l#ts)
  note ith = (l#ts)!i = (p,is,θ,Readsb volatile a t v#sb,𝒟,𝒪,)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,is,θ,Readsb volatile a t v#sb,𝒟,𝒪,)"
      by simp
    thus ?thesis 
      by (simp add: 0 del: fun_upd_apply)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l,l)"
      by (cases l)

    from i_bound ith
    have "flush_all_until_volatile_write (ts[n := (p,is,θ, sb, 𝒟', 𝒪,ℛ')])
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m) =
         flush_all_until_volatile_write ts
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m)"
      apply -
      apply (rule Cons.hyps)
      apply (auto simp add: Suc l)
      done

    then show ?thesis
      by (simp add: Suc l)
  qed
qed

lemma flush_all_until_volatile_write_Ghostsb_commute:
  "i m. i < length ts; ts!i=(p,is,θ,Ghostsb A L R W#sb,𝒟,𝒪,)
        flush_all_until_volatile_write (ts[i := (p',is',θ', sb, 𝒟', 𝒪',ℛ')]) m
       = flush_all_until_volatile_write ts m"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons l ts)
  note i_bound =  i < length (l#ts)
  note ith = (l#ts)!i = (p,is,θ,Ghostsb A L R W#sb,𝒟,𝒪,)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,is,θ,Ghostsb A L R W#sb,𝒟,𝒪,)"
      by simp
    thus ?thesis 
      by (simp add: 0 del: fun_upd_apply)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l,l)"
      by (cases l)

    from i_bound ith
    have "flush_all_until_volatile_write (ts[n := (p',is',θ', sb, 𝒟', 𝒪',ℛ')])
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m) =
         flush_all_until_volatile_write ts
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m)"
      apply -
      apply (rule Cons.hyps)
      apply (auto simp add: Suc l)
      done

    then show ?thesis
      by (simp add: Suc l)
  qed
qed

lemma flush_all_until_volatile_write_Progsb_commute:
  "i m. i < length ts; ts!i=(p,is,θ,Progsb p1 p2 mis#sb,𝒟,𝒪,)
        flush_all_until_volatile_write (ts[i := (p,is, θ, sb,𝒟', 𝒪,ℛ')]) m
       = flush_all_until_volatile_write ts m"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons l ts)
  note i_bound =  i < length (l#ts)
  note ith = (l#ts)!i = (p,is,θ,Progsb p1 p2 mis#sb,𝒟,𝒪,)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,is,θ,Progsb p1 p2 mis#sb,𝒟,𝒪,)"
      by simp
    thus ?thesis 
      by (simp add: 0 del: fun_upd_apply)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l,l)"
      by (cases l)

    from i_bound ith
    have "flush_all_until_volatile_write (ts[n := (p,is, θ, sb,𝒟', 𝒪,ℛ')])
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m) =
         flush_all_until_volatile_write ts
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m)"
      apply -
      apply (rule Cons.hyps)
      apply (auto simp add: Suc l)
      done

    then show ?thesis
      by (simp add: Suc l)
  qed
qed


lemma flush_all_until_volatile_write_append_Progsb_commute:
  "i m. i < length ts; ts!i=(p,is,θ,sb,𝒟,𝒪,)
        flush_all_until_volatile_write (ts[i := (p2,is@mis, θ, sb@[Progsb p1 p2 mis],𝒟', 𝒪,ℛ')]) m
       = flush_all_until_volatile_write ts m"
proof (induct ts)
  case Nil thus ?case
    by simp
next
  case (Cons l ts)
  note i_bound =  i < length (l#ts)
  note ith = (l#ts)!i = (p,is,θ,sb,𝒟,𝒪,)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,is,θ,sb,𝒟,𝒪,)"
      by simp
    thus ?thesis 
      by (simp add: 0 flush_append_Progsb del: fun_upd_apply)
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l,l)"
      by (cases l)

    from i_bound ith
    have "flush_all_until_volatile_write 
              (ts[n := (p2,is@mis,θ, sb@[Progsb p1 p2 mis], 𝒟', 𝒪,ℛ')])
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m) =
         flush_all_until_volatile_write ts
           (flush (takeWhile (Not  is_volatile_Writesb) sbl) m)"
      apply -
      apply (rule Cons.hyps)
      apply (auto simp add: Suc l)
      done

    then show ?thesis
      by (simp add: Suc l)
  qed
qed




lemma (in program) history_consistent_append_Progsb:
  assumes step: "θ p p (p', mis)"
  shows "history_consistent θ (hd_prog p xs) xs  last_prog p xs = p 
       history_consistent θ (hd_prog p' (xs@[Progsb p p' mis])) (xs@[Progsb p p' mis])"
proof (induct xs)
  case Nil with step show ?case by simp
next
  case (Cons x xs)
  note consis = ‹history_consistent θ (hd_prog p (x # xs)) (x # xs)
  note last = ‹last_prog p (x#xs) = p
  show ?case
  proof (cases x)
    case Writesb with Cons show ?thesis by (auto simp add: read_tmps_append)
  next
    case Readsb with Cons show ?thesis by (auto split: option.splits)
  next
    case (Progsb p1 p2 mis')
    from consis obtain
      step: "θ |`(dom θ - read_tmps (xs @ [Progsb p p' mis])) p1 p (p2, mis')" and
      consis': "history_consistent θ p2 xs"
      by (auto simp add: Progsb read_tmps_append)
    from last have last_p2: "last_prog p2 xs = p"
      by (simp add: Progsb)
    from last_prog_to_last_prog_same [OF this]
    have last_prog': "last_prog p xs = p".
    from history_consistent_hd_prog [OF consis']
    have consis'': "history_consistent θ (hd_prog p xs) xs".
    from Cons.hyps [OF this last_prog']
    have "history_consistent θ (hd_prog p' (xs @ [Progsb p p' mis]))
            (xs @ [Progsb p p' mis])".
    from history_consistent_hd_prog [OF this]
    have "history_consistent θ (hd_prog p2 (xs @ [Progsb p p' mis])) 
           (xs @ [Progsb p p' mis])".
    moreover
    from history_consistent_hd_prog_p [OF consis'] 
    have "p2 = hd_prog p2 xs".
    from hd_prog_last_prog_append_Progsb [OF this [symmetric] last_p2]
    have "hd_prog p2 (xs @ [Progsb p p' mis]) = p2"
      by simp
    ultimately
    have "history_consistent θ p2 (xs @ [Progsb p p' mis])"
      by simp
    thus ?thesis
      by (simp add: Progsb step)
  next
    case Ghostsb with Cons show ?thesis by (auto)
  qed
qed


(* FIXME: consistent naming: acquired vs. acquire; released vs. release *)
(* augment_rels, really only depends on the owned part of dom 𝒮. *)
primrec release :: "'a memref list  addr set  rels  rels"
where
"release [] S  = "
| "release (x#xs) S  =
  (case x of
     Writesb volatile _ _ _ A L R W  
        (if volatile then release xs (S  R - L) Map.empty 
         else release xs S )
   | Ghostsb A L R W  release xs (S  R - L) (augment_rels S R ) 
   | _  release xs S )"


lemma augment_rels_shared_exchange: "a  R. (a  S') = (a  S)  augment_rels S R  = augment_rels S' R "
apply (rule ext)
apply (auto simp add: augment_rels_def split: option.splits)
done


lemma sharing_consistent_shared_exchange: 
assumes shared_eq: "a  all_acquired sb. 𝒮' a = 𝒮 a"
assumes consis: "sharing_consistent 𝒮 𝒪 sb" 
shows "sharing_consistent 𝒮' 𝒪 sb"
using shared_eq consis
proof (induct sb arbitrary: 𝒮 𝒮' 𝒪)
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True

      from Cons.prems obtain 
	A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and
        shared_eq: "a  A  all_acquired sb. 𝒮' a = 𝒮 a"
	by (clarsimp simp add: Writesb True )
      from shared_eq
      have shared_eq': "a all_acquired sb. (𝒮'W RA L) a = (𝒮W RA L) a"
        by (auto simp add: augment_shared_def restrict_shared_def)
      from Cons.hyps [OF shared_eq' consis']
      have "sharing_consistent (𝒮'W RA L) (𝒪  A - R) sb".
      thus ?thesis
      using A_shared_owns L_A A_R R_owns shared_eq
        by (auto  simp add: Writesb True domIff)
    next
      case False with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis
      by auto
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W) 
    from Cons.prems obtain 
      A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and
      shared_eq: "a  A  all_acquired sb. 𝒮' a = 𝒮 a"
      by (clarsimp simp add: Ghostsb )
    from shared_eq
    have shared_eq': "aall_acquired sb. (𝒮'W RA L) a = (𝒮W RA L) a"
      by (auto simp add: augment_shared_def restrict_shared_def)
    from Cons.hyps [OF shared_eq' consis']
    have "sharing_consistent (𝒮'W RA L) (𝒪  A - R) sb".
    thus ?thesis
    using A_shared_owns L_A A_R R_owns shared_eq
      by (auto  simp add: Ghostsb domIff)
  qed
qed



lemma release_shared_exchange: 
assumes shared_eq: "a  𝒪  all_acquired sb. 𝒮' a = 𝒮 a"
assumes consis: "sharing_consistent 𝒮 𝒪 sb" 
shows "release sb (dom 𝒮')  = release sb (dom 𝒮) "
using shared_eq consis 
proof (induct sb arbitrary: 𝒮 𝒮' 𝒪 )
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True

      from Cons.prems obtain 
	A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and
        shared_eq: "a  𝒪  A  all_acquired sb. 𝒮' a = 𝒮 a"
	by (clarsimp simp add: Writesb True )
      from shared_eq
      have shared_eq': "a𝒪  A - R  all_acquired sb. (𝒮'W RA L) a = (𝒮W RA L) a"
        by (auto simp add: augment_shared_def restrict_shared_def)
      from Cons.hyps [OF shared_eq' consis']
      have "release sb (dom (𝒮'W RA L)) Map.empty = release sb (dom (𝒮W RA L)) Map.empty" .
      then show ?thesis
        by (auto  simp add: Writesb True domIff) 
    next
      case False with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis
      by auto
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W) 
    from Cons.prems obtain 
      A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and
      shared_eq: "a  𝒪  A  all_acquired sb. 𝒮' a = 𝒮 a"
      by (clarsimp simp add: Ghostsb )
    from shared_eq
    have shared_eq': "a𝒪  A - R  all_acquired sb. (𝒮'W RA L) a = (𝒮W RA L) a"
      by (auto simp add: augment_shared_def restrict_shared_def)
    from A_shared_owns shared_eq R_owns have "aR. (a  dom 𝒮) = (a  dom 𝒮')"
      by (auto simp add: domIff)
    from augment_rels_shared_exchange [OF this]
    have "(augment_rels (dom 𝒮') R ) = (augment_rels (dom 𝒮) R )".
    
    with Cons.hyps [OF shared_eq' consis']
    have "release sb (dom (𝒮'W RA L)) (augment_rels (dom 𝒮') R ) = 
            release sb (dom (𝒮W RA L)) (augment_rels (dom 𝒮) R )" by simp
    then show ?thesis
      by (clarsimp  simp add: Ghostsb domIff) 
  qed
qed

lemma release_append: 
"𝒮 . release (sb@xs) (dom 𝒮)  = release xs (dom (share sb 𝒮)) (release sb (dom (𝒮)) )"
proof (induct sb)
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      from Cons.hyps [of "(𝒮W RA L)" "Map.empty"]
      show ?thesis
        by (clarsimp simp add: Writesb True)
    next
      case False with Cons show ?thesis by (auto simp add: Writesb)
   qed
  next
    case Readsb with Cons show ?thesis
      by auto
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W) 
    with Cons.hyps [of "(𝒮W RA L)" "augment_rels (dom 𝒮) R "]
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed

locale xvalid_program = valid_program +
  fixes valid
  assumes valid_implies_valid_prog:     
     "i < length ts; 
      ts!i = (p,is,θ,sb,𝒟,𝒪,); valid ts  valid_prog p" 

  assumes valid_implies_valid_prog_hd:     
     "i < length ts; 
      ts!i = (p,is,θ,sb,𝒟,𝒪,); valid ts  valid_prog (hd_prog p sb)" 
  assumes distinct_load_tmps_prog_step: 
    "i < length ts; 
      ts!i = (p,is,θ,sb,𝒟,𝒪,); θp p (p',is'); valid ts 
     
      distinct_load_tmps is'  
      (load_tmps is'  load_tmps is = {}) 
      (load_tmps is'  read_tmps sb) = {}"

  assumes valid_data_dependency_prog_step: 
    "i < length ts;
      ts!i = (p,is,θ,sb,𝒟,𝒪,); θp p (p',is'); valid ts 
      
     data_dependency_consistent_instrs (dom θ  load_tmps is) is'  
     load_tmps is'  (fst ` store_sops is)  = {} 
     load_tmps is'  (fst ` write_sops sb)  = {}"

  assumes load_tmps_fresh_prog_step:
  "i < length ts;
      ts!i = (p,is,θ,sb,𝒟,𝒪,); θp p (p',is'); valid ts 
    
   load_tmps is'  dom θ = {}"

  assumes valid_sops_prog_step:
      "θp p (p',is'); valid_prog p sopstore_sops is'. valid_sop sop"

  assumes prog_step_preserves_valid:
      "i < length ts;
        ts!i = (p,is,θ,sb,𝒟,𝒪,); θp p (p',is'); valid ts 
        valid (ts[i:=(p',is@is',θ,sb@[Progsb p p' is'],𝒟,𝒪,)])"

  assumes flush_step_preserves_valid:
      "i < length ts;
        ts!i = (p,is,θ,sb,𝒟,𝒪,); (m,sb,𝒪,,𝒮) f (m',sb',𝒪',ℛ',𝒮'); valid ts 
        valid (ts[i:=(p,is,θ,sb',𝒟,𝒪',ℛ')])"

  assumes sbh_step_preserves_valid:
      "i < length ts;
        ts!i = (p,is,θ,sb,𝒟,𝒪,); 
        (is,θ,sb,m,𝒟,𝒪,,𝒮) sbh (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮'); 
       valid ts 
       
       valid (ts[i:=(p,is',θ',sb',𝒟',𝒪',ℛ')])"



lemma refl': "x = y  r^** x y"
  by auto



lemma no_volatile_Readsb_volatile_reads_consistent:
  "m. outstanding_refs is_volatile_Readsb sb = {}  volatile_reads_consistent m sb"
  apply (induct sb)
  apply  simp
  subgoal for a sb m
  apply (case_tac a)
  apply (auto split: if_split_asm)
  done
  done


theorem (in program) flush_store_buffer_append:
shows "ts p m θ 𝒪  𝒟 𝒮 is  𝒪'. 
 i < length ts;
  instrs (sb@sb') @ issb = is @ prog_instrs (sb@sb');
  causal_program_history issb (sb@sb');
  ts!i = (p,is,θ |` (dom θ - read_tmps (sb@sb')),x,𝒟,𝒪,);
  p=hd_prog psb (sb@sb');
  (last_prog psb (sb@sb')) = psb;
  reads_consistent True 𝒪' m sb; 
  history_consistent θ p (sb@sb');
  sop  write_sops sb. valid_sop sop;
  distinct_read_tmps (sb@sb');
  volatile_reads_consistent m sb

  
  is'. instrs sb' @ issb = is' @ prog_instrs sb' 
     (ts,m,𝒮) d* 
     (ts[i:=(last_prog (hd_prog psb sb') sb,is',θ|` (dom θ - read_tmps sb'),x,
       (𝒟  outstanding_refs is_volatile_Writesb sb  {}),
       acquired True sb 𝒪, release sb (dom 𝒮) )], flush sb m,share sb 𝒮)"
proof (induct sb)
  case Nil
  thus ?case by (auto simp add: list_update_id' split: if_split_asm)
next
case (Cons r sb)
  interpret direct_computation:
    computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb".
  have ts_i: 
    "ts!i = (p,is,θ |` (dom θ - read_tmps ((r#sb)@sb')),x,𝒟,𝒪,)"
    by fact
  have "is": "instrs ((r # sb) @ sb') @ issb = is @ prog_instrs ((r # sb) @ sb')" by fact

 
  have i_bound: "i < length ts" by fact
  have causal: "causal_program_history issb ((r # sb) @ sb')" by fact
  hence causal': "causal_program_history issb (sb @ sb')" 
    by (auto simp add: causal_program_history_def)

  note reads_consis = ‹reads_consistent True 𝒪' m (r#sb)
  note p = p = hd_prog psb ((r#sb)@sb')
  note psb = ‹last_prog psb ((r # sb) @ sb') = psb
  note hist_consis = ‹history_consistent θ p ((r#sb)@sb')
  note valid_sops = sop  write_sops (r#sb). valid_sop sop
  note dist = ‹distinct_read_tmps ((r#sb)@sb')
  note vol_read_consis = ‹volatile_reads_consistent m (r#sb)

  show ?case
  proof (cases r)
    case (Progsb p1 p2 pis)

    from vol_read_consis
    have vol_read_consis': "volatile_reads_consistent m sb"
      by (auto simp add: Progsb)

    from hist_consis  obtain
      prog_step: "θ|` (dom θ - read_tmps (sb @ sb')) p1 p (p2, pis)" and
      hist_consis': "history_consistent θ p2 (sb @ sb')" 
      by (auto simp add: Progsb)
    from p obtain  p: "p = p1" 
      by (simp add: Progsb)

    from history_consistent_hd_prog [OF hist_consis']
    have hist_consis'': "history_consistent θ (hd_prog p2 (sb @ sb')) (sb @ sb')" .
    from "is"
    have "is": "instrs (sb @ sb') @ issb = (is @ pis) @ prog_instrs (sb @ sb')"
      by (simp add: Progsb)
    
    
    from ts_i "is" have 
      ts_i: "ts!i = (p, is,θ |` (dom θ - read_tmps (sb @ sb')), x, 𝒟, 𝒪,)"
      by (simp add: Progsb)
   
    let ?ts'= "ts[i:=(p2,is@pis,θ |` (dom θ - read_tmps (sb @ sb')), x,𝒟,𝒪,)]"
    from direct_computation.Program [OF i_bound ts_i prog_step [simplified p[symmetric]]]
    have "(ts,m,𝒮) d (?ts',m,𝒮)" by simp    

    also
    from i_bound have i_bound': "i < length ?ts'"
      by auto

    from i_bound
    have ts'_i: "?ts'!i = (p2,is@pis,(θ |` (dom θ - read_tmps (sb @ sb'))),x, 𝒟, 𝒪,)"
      by auto

    from history_consistent_hd_prog_p [OF hist_consis'] 
    have p2_hd_prog: " p2 = hd_prog p2 (sb @ sb')".

    from reads_consis have reads_consis': "reads_consistent True 𝒪' m sb"
      by (simp add: Progsb)

    from valid_sops have valid_sops': "sop  write_sops sb. valid_sop sop"
      by (simp add: Progsb)

    from dist have dist': "distinct_read_tmps (sb@sb')"
      by (simp add: Progsb)
    

    from psb have last_prog_p2: "last_prog p2 (sb @ sb') = psb"
      by (simp add: Progsb)
    from hd_prog_last_prog_end [OF p2_hd_prog this]
    have p2_hd_prog': "p2 = hd_prog psb (sb @ sb')".
    from last_prog_p2 [symmetric] have last_prog': "last_prog psb (sb @ sb') = psb"
      by (simp add: last_prog_idem)
    

    from Cons.hyps [OF i_bound'  "is" causal' ts'_i p2_hd_prog' last_prog' reads_consis' 
      hist_consis' valid_sops' dist' vol_read_consis'] i_bound 
    obtain is' where
      is': "instrs sb' @ issb = is' @ prog_instrs sb'" and
      step: "(?ts', m,𝒮) d*
         (ts[i := (last_prog (hd_prog psb sb') sb, is',
          θ |` (dom θ - read_tmps sb'), x, 𝒟  outstanding_refs is_volatile_Writesb sb  {},
          acquired True sb 𝒪,release sb (dom 𝒮) )],
          flush sb m,share sb 𝒮 )"
      by (auto)
    from p2_hd_prog' 
    have last_prog_eq: "last_prog (hd_prog psb sb') sb = last_prog p2 sb"
      by (simp add: last_prog_hd_prog_append)
    note step
    finally show ?thesis
      using is' 
      by (simp add: Progsb last_prog_eq)
  next
    case (Writesb volatile a sop v A L R W)
    obtain D f where sop: "sop=(D,f)"
      by (cases sop)


    from vol_read_consis
    have vol_read_consis': "volatile_reads_consistent (m(a:=v)) sb"
      by (auto simp add: Writesb)

    from hist_consis obtain 
      D_tmps: "D  dom θ" and
      f_v: "f θ = v" and
      dep: "D  read_tmps (sb@sb') = {}" and
      hist_consis': "history_consistent θ p (sb@sb')"
      by (simp add: Writesb sop split: option.splits)

    from dist have dist': "distinct_read_tmps (sb@sb')" by (auto simp add: Writesb)

    from valid_sops obtain "valid_sop sop" and
      valid_sops': "sop  write_sops sb. valid_sop sop" 
      by (simp add: Writesb)
    interpret valid_sop sop by fact
    from valid_sop [OF sop D_tmps]
    have "f θ = f (θ |` D)" .
    moreover
    from dep D_tmps have D_subset: "D  (dom θ - read_tmps (sb@sb'))"
      by auto
    moreover from D_subset have "(θ|`(dom θ - read_tmps (sb@sb')) |` D) = θ |` D"
      apply -
      apply (rule ext)
      apply (auto simp add: restrict_map_def)
      done
    moreover from D_subset D_tmps have "D  dom (θ |` (dom θ - read_tmps (sb@sb')))"
      by simp
    moreover
    note valid_sop [OF sop this] 
    ultimately have f_v': "f (θ|`(dom θ - read_tmps (sb@sb'))) = v"
      by (simp add: f_v)

    interpret causal': causal_program_history "issb" "sb@sb'" by fact

    from "is"
    have "Write volatile a sop A L R W# instrs (sb @ sb') @ issb = is @ prog_instrs (sb @ sb')"
      by (simp add: Writesb)
    with causal'.causal_program_history [of "[]", simplified, OF refl]    
    obtain is' where "is": "is=Write volatile a sop A L R W#is'" and
      is': "instrs (sb @ sb') @ issb = is' @ prog_instrs (sb @ sb')"
      by auto

    from ts_i "is"
    have ts_i: "ts!i = (p,Write volatile a sop A L R W#is',
      θ |` (dom θ - read_tmps (sb@sb')),x,𝒟,𝒪,)"
      by (simp add: Writesb)
    
    from p have p': "p = hd_prog psb (sb@sb')"
      by (auto simp add: Writesb hd_prog_idem)

    from psb have psb': "last_prog psb (sb @ sb') = psb"
      by (simp add: Writesb)

    show ?thesis
    proof (cases volatile)
      case False
      have memop_step:
	"(Write volatile a sop A L R W#is',θ|`(dom θ - read_tmps (sb@sb')),
                 x,m,𝒟,𝒪,,𝒮)  
           (is',θ|` (dom θ - read_tmps (sb@sb')),x,m(a:=v),𝒟,𝒪,,𝒮)"
	using D_subset
	apply (simp only: sop f_v' [symmetric] False)
	apply (rule direct_memop_step.WriteNonVolatile)
	done
    
      let ?ts' = "ts[i := (p, is',θ |` (dom θ - read_tmps (sb @ sb')),x, 𝒟, 𝒪,)]"
      from direct_computation.Memop [OF i_bound ts_i  memop_step]
      have "(ts, m, 𝒮) d (?ts', m(a := v), 𝒮)".

      also
      from reads_consis have reads_consis': "reads_consistent True 𝒪' (m(a:=v)) sb"
	by (auto simp add: Writesb False)
      from i_bound have i_bound': "i < length ?ts'"
	by auto
    
      from i_bound
      have ts'_i: "?ts' ! i = (p, is',θ |` (dom θ - read_tmps (sb @ sb')), x, 𝒟, 𝒪,)"
	by simp      

      from Cons.hyps [OF i_bound' is' causal' ts'_i p' psb' reads_consis' hist_consis' 
	valid_sops' dist' vol_read_consis'] i_bound
      obtain is'' where
	is'': "instrs sb' @ issb = is'' @ prog_instrs sb'" and
	steps: "(?ts',m(a:=v),𝒮) d* 
        (ts[i := (last_prog (hd_prog psb sb') sb, is'',
	    θ |` (dom θ - read_tmps sb'), x, 
            𝒟  outstanding_refs is_volatile_Writesb sb  {}, acquired True sb 𝒪, release sb (dom 𝒮) )],
         flush sb (m(a := v)),share sb 𝒮)"
	by (auto simp del: fun_upd_apply)
      note steps
      finally
      show ?thesis
	using is''
	by (simp add: Writesb False)
    next
      case True
      have memop_step:
	"(Write volatile a sop A L R W#is',θ|`(dom θ - read_tmps (sb@sb')),
                 x,m,𝒟,𝒪,,𝒮 )  
           (is',θ|` (dom θ - read_tmps (sb@sb')),x,m(a:=v),True,𝒪  A - R,Map.empty,𝒮W RA L)"
	using D_subset
	apply (simp only: sop f_v' [symmetric] True)
	apply (rule direct_memop_step.WriteVolatile)
	done

      let ?ts' = "ts[i := (p, is', θ |` (dom θ - read_tmps (sb @ sb')),x, True, 𝒪  A - R,Map.empty)]"
      from direct_computation.Memop [OF i_bound ts_i  memop_step]
      have "(ts, m, 𝒮) d (?ts', m(a := v), 𝒮W RA L)".

      also
      from reads_consis have reads_consis': "reads_consistent True (𝒪'  A - R)(m(a:=v)) sb"
	by (auto simp add: Writesb True)
      from i_bound have i_bound': "i < length ?ts'"
	by auto
    
      from i_bound
      have ts'_i: "?ts' ! i = (p, is',θ |` (dom θ - read_tmps (sb @ sb')), x, True, 𝒪  A - R,Map.empty)"
	by simp      

      from Cons.hyps [OF i_bound' is' causal' ts'_i p' psb' reads_consis' hist_consis' 
	valid_sops' dist' vol_read_consis', of "(𝒮W RA L)"] i_bound
      obtain is'' where
	is'': "instrs sb' @ issb = is'' @ prog_instrs sb'" and
	steps: "(?ts',m(a:=v),𝒮W RA L) d* 
        (ts[i := (last_prog (hd_prog psb sb') sb, is'',
            θ |` (dom θ - read_tmps sb'), x, 
	    True, acquired True sb (𝒪  A - R),release sb (dom (𝒮W RA L)) Map.empty)],
         flush sb (m(a := v)), share sb (𝒮W RA L))"
	by (auto simp del: fun_upd_apply)
      note steps
      finally
      show ?thesis
	using is''
	by (simp add: Writesb True)
    qed
  next
    case (Readsb volatile a t v)

    from vol_read_consis reads_consis obtain v: "v=m a" and r_consis: "reads_consistent True 𝒪' m sb" and
      vol_read_consis': "volatile_reads_consistent m sb"
      by (cases volatile) (auto simp add: Readsb)

    from valid_sops have valid_sops': "sop  write_sops sb. valid_sop sop"  
      by (simp add: Readsb)

    from hist_consis obtain θ: "θ t = Some v" and 
      hist_consis': "history_consistent θ p (sb@sb')" 
      by (simp add: Readsb split: option.splits)
    from dist obtain t_notin: "t  read_tmps (sb@sb')" and
      dist': "distinct_read_tmps (sb@sb')" by (simp add: Readsb)
    from θ t_notin have restrict_commute:
      "(θ|` (dom θ - read_tmps (sb@sb')))(tv) =
        θ|` (dom θ - read_tmps (sb@sb'))"
      apply -
      apply (rule ext)
      apply (auto simp add: restrict_map_def domIff)
      done
    from θ t_notin 
    have restrict_commute': 
      "((θ |` (dom θ - insert t (read_tmps (sb@sb'))))(t  v)) =
          θ|` (dom θ - read_tmps (sb@sb'))"
      apply -
      apply (rule ext)
      apply (auto simp add: restrict_map_def domIff)
      done

    interpret causal': causal_program_history "issb" "sb@sb'" by fact

    from "is"
    have "Read volatile a t # instrs (sb @ sb') @ issb = is @ prog_instrs (sb @ sb')"
      by (simp add: Readsb)

    with causal'.causal_program_history [of "[]", simplified, OF refl]    
    obtain is' where "is": "is=Read volatile a t#is'" and
      is': "instrs (sb @ sb') @ issb = is' @ prog_instrs (sb @ sb')"
      by auto

    from ts_i "is"
    have ts_i: "ts!i = (p,Read volatile a t#is',
                 θ |` (dom θ - insert t (read_tmps (sb@sb'))),x,𝒟,𝒪,)"
      by (simp add: Readsb)

    from direct_memop_step.Read [of volatile a t "is'" "θ|` (dom θ - insert t (read_tmps (sb@sb')))" x m 𝒟 𝒪  𝒮]
    have memop_step: " 
          (Read volatile a t # is',
            θ |` (dom θ - insert t (read_tmps (sb @ sb'))), x, m, 𝒟, 𝒪,,𝒮)  
          (is',
             θ |` (dom θ - (read_tmps (sb @ sb'))), x, m, 𝒟, 𝒪, ,𝒮)"
      by (simp add: v [symmetric] restrict_commute restrict_commute')

    let ?ts' = "ts[i := (p, is',
                 θ |` (dom θ - read_tmps (sb @ sb')),x, 𝒟, 𝒪,)]"

    from direct_computation.Memop [OF i_bound ts_i memop_step]
    have "(ts, m, 𝒮) d (?ts', m, 𝒮)".

    also

    from i_bound have i_bound': "i < length ?ts'"
      by auto

    from i_bound
    have ts'_i: "?ts'!i = (p,is', (θ |` (dom θ - read_tmps (sb @ sb'))),x,𝒟, 𝒪, )"
      by auto

    from p have p': "p = hd_prog psb (sb@sb')"
      by (auto simp add: Readsb hd_prog_idem)

    from psb have psb': "last_prog psb (sb @ sb') = psb"
      by (simp add: Readsb)

    
    from Cons.hyps [OF i_bound' is' causal' ts'_i p' psb' r_consis  hist_consis'
    valid_sops' dist' vol_read_consis']
    
    obtain is'' where
      is'': "instrs sb' @ issb = is'' @ prog_instrs sb'" and
      steps: "(?ts',m,𝒮) d* 
          (ts[i := (last_prog (hd_prog psb sb') sb, is'',
             θ |` (dom θ - read_tmps sb'),x, 𝒟  outstanding_refs is_volatile_Writesb sb  {}, 
             acquired True sb 𝒪, release sb (dom 𝒮) )],
             flush sb m,share sb 𝒮)"
      by (auto simp del: fun_upd_apply)

    note steps
    finally
    show ?thesis
      using is''
      by (simp add: Readsb)
  next
    case (Ghostsb A L R W)

    from vol_read_consis
    have vol_read_consis': "volatile_reads_consistent m sb"
      by (auto simp add: Ghostsb)

    from reads_consis have  r_consis: "reads_consistent True (𝒪'  A - R) m sb"
      by (auto simp add: Ghostsb)

    from valid_sops have valid_sops': "sop  write_sops sb. valid_sop sop"  
      by (simp add: Ghostsb)

    from hist_consis obtain 
      hist_consis': "history_consistent θ p (sb@sb')" 
      by (simp add: Ghostsb)

    from dist obtain 
      dist': "distinct_read_tmps (sb@sb')" by (simp add: Ghostsb)

    interpret causal': causal_program_history "issb" "sb@sb'" by fact

    from "is"
    have "Ghost A L R W# instrs (sb @ sb') @ issb = is @ prog_instrs (sb @ sb')"
      by (simp add: Ghostsb)

    with causal'.causal_program_history [of "[]", simplified, OF refl]    
    obtain is' where "is": "is=Ghost A L R W#is'" and
      is': "instrs (sb @ sb') @ issb = is' @ prog_instrs (sb @ sb')"
      by auto

    from ts_i "is"
    have ts_i: "ts!i = (p,Ghost A L R W#is',
                 θ |` (dom θ - (read_tmps (sb@sb'))),x,𝒟,𝒪,)"
      by (simp add: Ghostsb)

    from direct_memop_step.Ghost [of A L R W "is'" 
      "θ|` (dom θ - (read_tmps (sb@sb')))" x  m 𝒟 "𝒪"  𝒮]
    have memop_step:"
      (Ghost A L R W# is',θ |` (dom θ - read_tmps (sb @ sb')), x, m, 𝒟, 𝒪, , 𝒮) 
       (is',θ |` (dom θ - read_tmps (sb @ sb')), x, m, 𝒟, 𝒪  A - R , augment_rels (dom 𝒮) R , 
      𝒮W  RA L)".

    let ?ts' = "ts[i := (p, is',
                 θ |` (dom θ - read_tmps (sb @ sb')),x, 𝒟, 𝒪  A - R, augment_rels (dom 𝒮) R )]"
    from direct_computation.Memop [OF i_bound ts_i memop_step]
    have "(ts, m, 𝒮) d (?ts', m, 𝒮W  RA L)".

    also

    from i_bound have i_bound': "i < length ?ts'"
      by auto

    from i_bound
    have ts'_i: "?ts'!i = (p,is',(θ |` (dom θ - read_tmps (sb @ sb'))),x, 𝒟, 𝒪  A - R,augment_rels (dom 𝒮) R  )"
      by auto

    from p have p': "p = hd_prog psb (sb@sb')"
      by (auto simp add: Ghostsb hd_prog_idem)

    from psb have psb': "last_prog psb (sb @ sb') = psb"
      by (simp add: Ghostsb)

    from Cons.hyps [OF   i_bound' is' causal' ts'_i p' psb' r_consis hist_consis' 
      valid_sops' dist' vol_read_consis', of "𝒮W  RA L"] 
    obtain is'' where
      is'': "instrs sb' @ issb = is'' @ prog_instrs sb'" and
      steps: "(?ts',m,𝒮W  RA L) d* 
          (ts[i := (last_prog (hd_prog psb sb') sb, is'',
             θ |` (dom θ - read_tmps sb'),x, 
             𝒟  outstanding_refs is_volatile_Writesb sb  {}, acquired True sb (𝒪  A - R), 
              release sb (dom (𝒮W RA L)) (augment_rels (dom 𝒮) R ))],
           flush sb m,share sb (𝒮W  RA L))"
      by (auto simp add: list_update_overwrite simp del: fun_upd_apply)

    note steps
    finally
    show ?thesis
      using is''
      by (simp add: Ghostsb)
  qed
qed

corollary  (in program) flush_store_buffer:
  assumes i_bound: "i < length ts"
  assumes instrs: "instrs sb @ issb = is @ prog_instrs sb"
  assumes cph: "causal_program_history issb sb"
  assumes ts_i: "ts!i = (p,is,θ |` (dom θ - read_tmps sb),x,𝒟,𝒪,)"
  assumes p: "p=hd_prog psb sb"
  assumes last_prog: "(last_prog psb sb) = psb"
  assumes reads_consis: "reads_consistent True 𝒪' m sb"
  assumes hist_consis: "history_consistent θ p sb"
  assumes valid_sops: "sop  write_sops sb. valid_sop sop"
  assumes dist: "distinct_read_tmps sb"
  assumes vol_read_consis: "volatile_reads_consistent m sb"
  shows "(ts,m,𝒮) d* 
         (ts[i:=(psb,issb, θ,x,
            𝒟  outstanding_refs is_volatile_Writesb sb  {},acquired True sb 𝒪, release sb (dom 𝒮) )],
             flush sb m,share sb 𝒮)"
using flush_store_buffer_append [where sb'="[]", simplified, OF i_bound instrs cph ts_i [simplified] p last_prog reads_consis hist_consis valid_sops dist vol_read_consis] last_prog
by simp


lemma last_prog_same_append: "xs psb. last_prog psb (sb@xs) = psb  last_prog psb xs = psb"
  apply (induct sb)
  apply  simp
  subgoal for a sb xs psb
  apply (case_tac a)
  apply     simp
  apply    simp
  apply   simp
  apply  (drule last_prog_to_last_prog_same)
  apply  simp
  apply simp
  done
  done


lemma reads_consistent_drop_volatile_writes_no_volatile_reads: 
  "pending_write 𝒪 m. reads_consistent pending_write 𝒪 m sb  
  outstanding_refs is_volatile_Readsb ((dropWhile (Not  is_volatile_Writesb)) sb) = {}"
  apply (induct sb)
  apply (auto split: memref.splits)
  done

(* cf reads_consistent_append
lemma reads_consistent_flush: 
"⋀m. reads_consistent m sb ⟹ 
  reads_consistent (flush (takeWhile (Not ∘ is_volatile_Writesb) sb) m) 
   (dropWhile (Not ∘ is_volatile_Writesb) sb)"
  apply (induct sb)
  apply  simp
  apply (case_tac a)
  apply auto
  done
*)


lemma reads_consistent_flush_other: 
  assumes no_volatile_Writesb_sb: "outstanding_refs is_volatile_Writesb sb = {}"
  shows "m pending_write 𝒪. 
  outstanding_refs (Not  is_volatile_Readsb) xs  outstanding_refs is_non_volatile_Writesb sb = {};
       reads_consistent pending_write 𝒪 m xs  reads_consistent pending_write 𝒪 (flush sb m) xs"
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x xs)
  note no_inter = ‹outstanding_refs (Not  is_volatile_Readsb) (x # xs)  
    outstanding_refs is_non_volatile_Writesb sb = {}
  hence no_inter': "outstanding_refs (Not  is_volatile_Readsb) xs  outstanding_refs is_non_volatile_Writesb sb = {}"
    by (auto)
  note consis = ‹reads_consistent pending_write 𝒪 m (x # xs)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R)
    show ?thesis
    proof (cases volatile)
      case False
      from consis obtain consis': "reads_consistent pending_write 𝒪 (m(a := v)) xs" 
	by (simp add: Writesb False)
      from Cons.hyps [OF no_inter' consis']
      have "reads_consistent pending_write 𝒪 (flush sb (m(a := v))) xs".
      moreover
      from no_inter have "a  outstanding_refs is_non_volatile_Writesb sb"
	by (auto simp add: Writesb split: if_split_asm)
    
      from flush_update_other' [OF this no_volatile_Writesb_sb]
      have "(flush sb (m(a := v))) = (flush sb m)(a := v)".
      ultimately
      show ?thesis
	by (simp add: Writesb False)
    next
      case True
      from consis obtain consis': "reads_consistent True (𝒪  A - R) (m(a := v)) xs" and
	no_read: "(outstanding_refs is_volatile_Readsb xs = {} )"
	by (simp add: Writesb True)
      from Cons.hyps [OF no_inter' consis']
      have "reads_consistent True (𝒪  A - R) (flush sb (m(a := v))) xs".
      moreover
      from no_inter have "a  outstanding_refs is_non_volatile_Writesb sb"
	by (auto simp add: Writesb split: if_split_asm)
    
      from flush_update_other' [OF this no_volatile_Writesb_sb]
      have "(flush sb (m(a := v))) = (flush sb m)(a := v)".
      ultimately
      show ?thesis
	using no_read
	by (simp add: Writesb True)
    qed
  next
    case (Readsb volatile a t v)
    from consis obtain val: "(¬ volatile  (pending_write  a  𝒪)  v = m a)" and
      consis': "reads_consistent pending_write 𝒪 m xs"
      by (simp add: Readsb)
    from Cons.hyps [OF no_inter' consis']
    have hyp: "reads_consistent pending_write 𝒪 (flush sb m) xs"
      by simp
    show ?thesis
    proof (cases volatile)
      case False
      from no_inter False have "a  outstanding_refs is_non_volatile_Writesb sb"
	by (auto simp add: Readsb split: if_split_asm)
      with no_volatile_Writesb_sb 
      have "a  outstanding_refs is_Writesb sb"
	apply (clarsimp simp add: outstanding_refs_conv is_Writesb_def split: memref.splits)
	apply force
	done
      with hyp val flush_unchanged_addresses  [OF this]
      show ?thesis
	by (simp add: Readsb)
    next
      case True
      with hyp val show ?thesis
	by (simp add: Readsb)
    qed
  next
    case Progsb with Cons show ?thesis by auto
  next
    case Ghostsb with Cons show ?thesis by auto
  qed
qed

lemma reads_consistent_flush_independent: 
  assumes no_volatile_Writesb_sb: "outstanding_refs is_Writesb sb  outstanding_refs is_non_volatile_Readsb xs = {}"
  assumes consis: "reads_consistent pending_write 𝒪 m xs" 
  shows "reads_consistent pending_write 𝒪 (flush sb m) xs"
proof -
  from flush_unchanged_addresses [where sb=sb and m=m] no_volatile_Writesb_sb
  have "a  outstanding_refs is_non_volatile_Readsb xs. flush sb m a = m a"
    by auto
  from reads_consistent_mem_eq_on_non_volatile_reads [OF this subset_refl consis]
  show ?thesis .
qed


lemma reads_consistent_flush_all_until_volatile_write_aux:
  assumes no_reads: "outstanding_refs is_volatile_Readsb xs = {}" 
  shows "m pending_write 𝒪'.  reads_consistent pending_write 𝒪' m xs; i < length ts. 
    let (p,is,θ,sb,𝒟,𝒪,) = ts!i in
      outstanding_refs (Not  is_volatile_Readsb) xs  
      outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sb) = {} 
  reads_consistent pending_write 𝒪' (flush_all_until_volatile_write ts m) xs"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  have consis: "reads_consistent pending_write 𝒪' m xs" by fact


  obtain pt "ist" 𝒪t t 𝒟t θt sbt 
    where t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
    by (cases t)

  from Cons.prems t obtain
    no_inter: "outstanding_refs (Not  is_volatile_Readsb) xs  
      outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbt) = {}" and
    no_inter': "i < length ts. 
    let (p,is,θ,sb,𝒟,𝒪,) = ts!i in
      outstanding_refs (Not  is_volatile_Readsb) xs  
      outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sb) = {}"
    by (force simp add: Let_def simp del: o_apply)


  have out1: "outstanding_refs is_volatile_Writesb 
    (takeWhile (Not  is_volatile_Writesb) sbt) = {}"
    by (auto simp add: outstanding_refs_conv dest: set_takeWhileD)

  from no_inter have "outstanding_refs (Not  is_volatile_Readsb) xs  
    outstanding_refs is_non_volatile_Writesb  (takeWhile (Not  is_volatile_Writesb) sbt) = {}" 
    by auto

  from reads_consistent_flush_other [OF out1 this consis]
 
  have "reads_consistent pending_write 𝒪' (flush (takeWhile (Not  is_volatile_Writesb) sbt) m) xs".
  from Cons.hyps [OF this no_inter']
  show ?case
    by (simp add: t)
qed

(* FIXME: delete
lemma read_only_reads_takeWhile_owns:
  "⋀𝒪. read_only_reads 𝒪 (takeWhile (Not ∘ is_volatile_Writesb) sb) ∩ 𝒪 = {}"
apply (induct sb)
apply clarsimp
apply (case_tac a)
apply auto
done
*)

lemma reads_consistent_flush_other': 
  assumes no_volatile_Writesb_sb: "outstanding_refs is_volatile_Writesb sb = {}"
  shows "m  𝒪. 
  outstanding_refs is_non_volatile_Writesb sb  
     (outstanding_refs is_volatile_Writesb xs   
         outstanding_refs is_non_volatile_Writesb xs  
         outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) xs)  
         (outstanding_refs is_non_volatile_Readsb (takeWhile (Not  is_volatile_Writesb) xs) - RO)  
         (𝒪  all_acquired (takeWhile (Not  is_volatile_Writesb) xs))  
   )  = {};
  reads_consistent False 𝒪 m xs;
   read_only_reads 𝒪 (takeWhile (Not  is_volatile_Writesb) xs)  RO 
   reads_consistent False 𝒪 (flush sb m) xs"
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x xs)

  note no_inter = Cons.prems (1)

  note consis = ‹reads_consistent False 𝒪 m (x # xs)
  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto


  note RO = ‹read_only_reads 𝒪 (takeWhile (Not  is_volatile_Writesb) (x#xs))  RO


  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R)
    show ?thesis
    proof (cases volatile)
      case False
      from consis obtain consis': "reads_consistent False 𝒪 (m(a := v)) xs" 
	by (simp add: Writesb False)

      from no_inter
      have no_inter': "outstanding_refs is_non_volatile_Writesb sb  
       (outstanding_refs is_volatile_Writesb xs   
         outstanding_refs is_non_volatile_Writesb xs  
         outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) xs)  
         (outstanding_refs is_non_volatile_Readsb (takeWhile (Not  is_volatile_Writesb) xs) - RO)  
         (𝒪  all_acquired (takeWhile (Not  is_volatile_Writesb) xs))
        ) = {}"
	by (clarsimp simp add: Writesb False aargh)


      from RO
      have RO': "read_only_reads 𝒪 (takeWhile (Not  is_volatile_Writesb) xs)  RO" 
	by (auto simp add: Writesb False)

      from Cons.hyps [OF no_inter' consis' RO']
      have "reads_consistent False 𝒪 (flush sb (m(a := v))) xs".
      moreover
      from no_inter have "a  outstanding_refs is_non_volatile_Writesb sb"
	by (auto simp add: Writesb split: if_split_asm)
    
      from flush_update_other' [OF this no_volatile_Writesb_sb]
      have "(flush sb (m(a := v))) = (flush sb m)(a := v)".
      ultimately
      show ?thesis
	by (simp add: Writesb False)
    next
      case True
      from consis obtain consis': "reads_consistent True (𝒪  A - R) (m(a := v)) xs" and
	no_read: "(outstanding_refs is_volatile_Readsb xs = {})"
	by (simp add: Writesb True)

      from no_inter obtain
	a_notin: "a  outstanding_refs is_non_volatile_Writesb sb" and
	disj: "(outstanding_refs (Not  is_volatile_Readsb) xs) 
	        outstanding_refs is_non_volatile_Writesb sb = {}"
	by (auto simp add: Writesb True aargh misc_outstanding_refs_convs)

      from reads_consistent_flush_other [OF no_volatile_Writesb_sb disj consis']

      have "reads_consistent True (𝒪  A - R) (flush sb (m(a := v))) xs".
      moreover
      note a_notin
    
      from flush_update_other' [OF this no_volatile_Writesb_sb]
      have "(flush sb (m(a := v))) = (flush sb m)(a := v)".
      ultimately
      show ?thesis
	using no_read
	by (simp add: Writesb True)
    qed
  next
    case (Readsb volatile a t v)
    from consis obtain val: "(¬ volatile  a  𝒪  v = m a)" and
      consis': "reads_consistent False 𝒪 m xs"
      by (simp add: Readsb)


    from RO
    have RO': "read_only_reads 𝒪 (takeWhile (Not  is_volatile_Writesb) xs)  RO"
      by (auto simp add: Readsb )

    from no_inter
    have no_inter': "outstanding_refs is_non_volatile_Writesb sb  
       (outstanding_refs is_volatile_Writesb xs   
        outstanding_refs is_non_volatile_Writesb xs  
        outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) xs)  
        (outstanding_refs is_non_volatile_Readsb (takeWhile (Not  is_volatile_Writesb) xs) - RO)  
        (𝒪  all_acquired (takeWhile (Not  is_volatile_Writesb) xs))
        ) = {}"
      by (fastforce simp add: Readsb aargh)


    show ?thesis
    proof (cases volatile)
      case True

      from Cons.hyps [OF no_inter' consis' RO'] 
      show ?thesis
	by (simp add: Readsb True)
    next
      case False
      note non_volatile=this

      from Cons.hyps [OF no_inter' consis' RO'] 
      have hyp: "reads_consistent False 𝒪 (flush sb m) xs".

      show ?thesis
      proof (cases "a  𝒪")
	case False
	with hyp show ?thesis
	  by (simp add: Readsb non_volatile False)
      next
	case True
	from no_inter True have a_notin: "a  outstanding_refs is_non_volatile_Writesb sb"
	  by blast

	with no_volatile_Writesb_sb 
	have "a  outstanding_refs is_Writesb sb"
	  apply (clarsimp simp add: outstanding_refs_conv is_Writesb_def split: memref.splits)
	  apply force
	  done

	from flush_unchanged_addresses  [OF this] hyp val 
	
	show ?thesis
	  by (simp add: Readsb non_volatile True)
      qed
    qed
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W)
    from consis obtain consis': "reads_consistent False (𝒪  A - R) m xs" 
      by (simp add: Ghostsb)

    from RO
    have RO': "read_only_reads (𝒪  A - R) (takeWhile (Not  is_volatile_Writesb) xs)  RO"
      by (auto simp add: Ghostsb)


    from no_inter
    have no_inter': "outstanding_refs is_non_volatile_Writesb sb   
      (outstanding_refs is_volatile_Writesb xs   
        outstanding_refs is_non_volatile_Writesb xs  
         outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) xs)  
         (outstanding_refs is_non_volatile_Readsb (takeWhile (Not  is_volatile_Writesb) xs) - RO)  
         (𝒪  A - R  all_acquired (takeWhile (Not  is_volatile_Writesb) xs))
        ) = {}"
      by (fastforce simp add: Ghostsb aargh)

    from Cons.hyps [OF no_inter' consis' RO' ] 
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed

lemma reads_consistent_flush_all_until_volatile_write_aux':
  assumes no_reads: "outstanding_refs is_volatile_Readsb xs = {}" 
  assumes read_only_reads_RO: "read_only_reads 𝒪' (takeWhile (Not  is_volatile_Writesb) xs)  RO"
  shows "m.  reads_consistent False 𝒪' m xs; i < length ts. 
    let (p,is,θ,sb,𝒟,𝒪) = ts!i in
      outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sb)  
       (outstanding_refs is_volatile_Writesb xs   
         outstanding_refs is_non_volatile_Writesb xs  
         outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) xs)  
         (outstanding_refs is_non_volatile_Readsb (takeWhile (Not  is_volatile_Writesb) xs) - RO)  
         (𝒪'  all_acquired (takeWhile (Not  is_volatile_Writesb) xs))
        )  
       = {}
 
  reads_consistent False 𝒪' (flush_all_until_volatile_write ts m) xs"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  have consis: "reads_consistent False 𝒪' m xs" by fact


  obtain pt "ist" 𝒪t t 𝒟t θt sbt 
    where t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
    by (cases t)

  obtain
    no_inter: "outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbt)  
    (outstanding_refs is_volatile_Writesb xs   
         outstanding_refs is_non_volatile_Writesb xs  
         outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) xs)  
         (outstanding_refs is_non_volatile_Readsb (takeWhile (Not  is_volatile_Writesb) xs) - RO)  
         (𝒪'  all_acquired (takeWhile (Not  is_volatile_Writesb) xs))

        )  
       = {}" and
    no_inter': "i < length ts. 
    let (p,is,θ,sb,𝒟,𝒪) = ts!i in
      outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sb)  
       (outstanding_refs is_volatile_Writesb xs   
         outstanding_refs is_non_volatile_Writesb xs  
         outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) xs)  
         (outstanding_refs is_non_volatile_Readsb (takeWhile (Not  is_volatile_Writesb) xs) - RO)  
         (𝒪'  all_acquired (takeWhile (Not  is_volatile_Writesb) xs))
        )  
    = {}"
  proof -
    show ?thesis
      apply (rule that)
      using  Cons.prems (2) [rule_format, of 0]
      apply  (clarsimp simp add: t)
      apply clarsimp
      using Cons.prems (2)
      apply -
      subgoal for i
      apply (drule_tac x="Suc i" in spec)
      apply (clarsimp simp add: Let_def simp del: o_apply)
      done
      done
  qed


  have out1: "outstanding_refs is_volatile_Writesb 
    (takeWhile (Not  is_volatile_Writesb) sbt) = {}"
    by (auto simp add: outstanding_refs_conv dest: set_takeWhileD)

  from reads_consistent_flush_other' [OF out1 no_inter consis read_only_reads_RO ] 
  have "reads_consistent False 𝒪' (flush (takeWhile (Not  is_volatile_Writesb) sbt) m) xs".
  from Cons.hyps [OF this no_inter']
  show ?case
    by (simp add: t)
qed





(* cf. reads_consistent_drop_volatile_writes_no_volatile_reads
lemma reads_consistent_no_volatile_Readsb_drop: "⋀m. reads_consistent m sb ⟹ 
   outstanding_refs is_volatile_Readsb (dropWhile (Not ∘ is_volatile_Writesb) sb) = {}"
apply (induct sb)
apply  simp
apply (case_tac a)
apply auto
done
*)

lemma in_outstanding_refs_cases [consumes 1, case_names Writesb Readsb]:
  "a  outstanding_refs P xs 
       (volatile sop v A L R W.  (Writesb volatile a sop v A L R W)  set xs  P (Writesb volatile a sop v A L R W)  C) 
       (volatile t v.  (Readsb volatile a t v)  set xs  P (Readsb volatile a t v)  C)
        C"
  apply (clarsimp simp add: outstanding_refs_conv)
  subgoal for x
  apply (case_tac x)
  apply fastforce+
  done
  done

lemma dropWhile_Cons: "(dropWhile P xs) = x#ys  ¬ P x"
apply (induct xs)
apply (auto split: if_split_asm)
done

lemma reads_consistent_dropWhile: 
  "reads_consistent pending_write 𝒪 m (dropWhile (Not  is_volatile_Writesb) sb) = 
       reads_consistent True 𝒪 m  (dropWhile (Not  is_volatile_Writesb) sb)"
apply (case_tac "(dropWhile (Not  is_volatile_Writesb) sb)")
apply (simp only:)
apply  simp
apply (frule dropWhile_Cons)
apply (auto split: memref.splits)
done


theorem 
  reads_consistent_flush_all_until_volatile_write: 
  "i m pending_write. valid_ownership_and_sharing 𝒮 ts; 
  i < length ts; ts!i = (p, is,θ, sb, 𝒟, 𝒪,); 
  reads_consistent pending_write 𝒪 m sb  
   reads_consistent True (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪)
  (flush_all_until_volatile_write ts m) (dropWhile (Not  is_volatile_Writesb) sb)"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  note i_bound = i < length (t # ts)
  note ts_i = (t # ts) ! i = (p, is,θ, sb, 𝒟, 𝒪,)
  note consis = ‹reads_consistent pending_write 𝒪 m sb
  note valid = ‹valid_ownership_and_sharing 𝒮 (t#ts)
  then interpret valid_ownership_and_sharing 𝒮 "t#ts".
  from valid_ownership_and_sharing_tl [OF valid] have valid': "valid_ownership_and_sharing 𝒮 ts".
    
  obtain pt "ist" 𝒪t t 𝒟t θt sbt 
    where t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
    by (cases t)
  show ?case
  proof (cases i)
    case 0
    with ts_i t have sb_eq: "sb=sbt"
      by simp

    let ?take_sb = "(takeWhile (Not  is_volatile_Writesb) sb)"
    let ?drop_sb = "(dropWhile (Not  is_volatile_Writesb) sb)"

    from reads_consistent_append [of pending_write 𝒪 m ?take_sb ?drop_sb] consis
    have consis': "reads_consistent True (acquired True ?take_sb 𝒪) (flush ?take_sb m) ?drop_sb"
      apply (cases "outstanding_refs is_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sb)  {}")
      apply  clarsimp
      apply clarsimp
      apply (simp add: reads_consistent_dropWhile [of pending_write])
      done


    from reads_consistent_drop_volatile_writes_no_volatile_reads [OF consis]
    have no_vol_Readsb: "outstanding_refs is_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) sb) = {}".
    hence "outstanding_refs (Not  is_volatile_Readsb) (dropWhile (Not  is_volatile_Writesb) sb)
           =
           outstanding_refs (λs. True) (dropWhile (Not  is_volatile_Writesb) sb)"
      by (auto simp add: outstanding_refs_conv)

    have "i<length ts.
     let (p, is,θ, sb', 𝒟, 𝒪,) = ts ! i
     in outstanding_refs (Not  is_volatile_Readsb) (dropWhile (Not  is_volatile_Writesb) sb) 
        outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sb') = {}"
    proof - 
      {
	fix j pj "isj" 𝒪j j 𝒟j θj sbj x
	assume j_bound: "j < length ts"
	assume ts_j: "ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	assume x_in_sb: "x  outstanding_refs (Not  is_volatile_Readsb) (dropWhile (Not  is_volatile_Writesb) sb)"
	assume x_in_j: "x  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	have False
	proof -
	  from outstanding_non_volatile_write_not_volatile_read_disj [rule_format, of "Suc j" 0, simplified, OF j_bound ts_j t]
	  sb_eq x_in_sb x_in_j 
	  show ?thesis
	    by auto
	qed
      }
      thus ?thesis
	by (auto simp add: Let_def)
    qed
    from reads_consistent_flush_all_until_volatile_write_aux [OF no_vol_Readsb consis' this]
    show ?thesis
      by (simp add: t sb_eq del: o_apply)
  next
    case (Suc k)
    with i_bound have k_bound: "k < length ts"
      by auto
      
    from ts_i Suc have ts_k: "ts ! k = (p, is,θ, sb, 𝒟, 𝒪,)"
      by simp



    have "reads_consistent False 𝒪 (flush (takeWhile (Not  is_volatile_Writesb) sbt) m) sb"
    proof -
      have no_vW: 
	"outstanding_refs is_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbt) = {}"
	apply (clarsimp simp add: outstanding_refs_conv )
	apply (drule set_takeWhileD)
	apply simp
	done
      
      
      from consis have consis': "reads_consistent False 𝒪 m sb"
	by (cases pending_write) (auto intro: reads_consistent_pending_write_antimono)
      note disj = outstanding_non_volatile_write_disj [where i=0, OF _  i_bound [simplified Suc], simplified, OF t ts_k ]
      
      
      from reads_consistent_flush_other' [OF no_vW disj consis' subset_refl] 
      show ?thesis .
    qed
    from Cons.hyps [OF valid' k_bound ts_k this]
    show ?thesis
      by (simp add: t)
  qed
qed


lemma split_volatile_Writesb_in_outstanding_refs:
  "a  outstanding_refs is_volatile_Writesb xs  (sop v ys zs A L R W. xs = ys@(Writesb True a sop v A L R W#zs))"
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x xs)
  have a_in: "a  outstanding_refs is_volatile_Writesb (x # xs)" by fact
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      from a_in have "a  outstanding_refs is_volatile_Writesb xs"
	by (auto simp add: False Writesb)
      from Cons.hyps [OF this] obtain sop'' v'' A'' L'' R'' W'' ys zs
	where "xs=ys@Writesb True a sop'' v'' A'' L'' R'' W''#zs"
	by auto
      hence "x#xs = (x#ys)@Writesb True a sop'' v'' A'' L'' R'' W''#zs"
	by auto
      thus ?thesis
	by blast
    next
      case True
      note volatile = this
      show ?thesis
      proof (cases "a'=a")
	case False
	with a_in have "a  outstanding_refs is_volatile_Writesb xs"
	  by (auto simp add: volatile Writesb)
	from Cons.hyps [OF this] obtain sop'' v'' A'' L'' R'' W'' ys zs
	  where "xs=ys@Writesb True a sop'' v'' A'' L'' R'' W''#zs"
	  by auto
	hence "x#xs = (x#ys)@Writesb True a sop'' v'' A'' L'' R'' W''#zs"
	  by auto
	thus ?thesis
	  by blast
      next
	case True
	then have "x#xs=[]@(Writesb True a sop v A L R W#xs)"
	  by (simp add: Writesb volatile True)
	thus ?thesis
	  by blast
      qed
    qed
  next
    case Readsb 
    from a_in have "a  outstanding_refs is_volatile_Writesb xs"
      by (auto simp add: Readsb)
    from Cons.hyps [OF this] obtain sop'' v'' A'' L'' R'' W'' ys zs
      where "xs=ys@Writesb True a sop'' v'' A'' L'' R'' W''#zs"
      by auto
    hence "x#xs = (x#ys)@Writesb True a sop'' v'' A'' L'' R'' W''#zs"
      by auto
    thus ?thesis
      by blast
  next
    case Progsb
    from a_in have "a  outstanding_refs is_volatile_Writesb xs"
      by (auto simp add: Progsb)
    from Cons.hyps [OF this] obtain sop'' v'' A'' L'' R'' W'' ys zs
      where "xs=ys@Writesb True a sop'' v'' A'' L'' R'' W''#zs"
      by auto
    hence "x#xs = (x#ys)@Writesb True a sop'' v'' A'' L'' R'' W''#zs"
      by auto
    thus ?thesis
      by blast
  next
    case Ghostsb
    from a_in have "a  outstanding_refs is_volatile_Writesb xs"
      by (auto simp add: Ghostsb)
    from Cons.hyps [OF this] obtain sop'' v'' A'' L'' R'' W'' ys zs
      where "xs=ys@Writesb True a sop'' v'' A'' L'' R'' W''#zs"
      by auto
    hence "x#xs = (x#ys)@Writesb True a sop'' v'' A'' L'' R'' W''#zs"
      by auto
    thus ?thesis
      by blast
  qed
qed

lemma sharing_consistent_mono_shared:
"𝒮 𝒮' 𝒪.
  dom 𝒮  dom 𝒮'  sharing_consistent 𝒮 𝒪 sb  sharing_consistent 𝒮' 𝒪 sb"
apply (induct sb)
apply simp
subgoal for a sb 𝒮 𝒮' 𝒪
apply (case_tac a)
apply    clarsimp
         subgoal for volatile a D f v A L R W  
         apply (frule_tac A="𝒮" and B="𝒮'" and C="R" and x="W" in augment_mono_aux)
         apply (frule_tac A="𝒮W R" and B="𝒮'W  R" and C="L" in restrict_mono_aux)
         apply blast
         done
apply   clarsimp
apply  clarsimp
apply clarsimp
subgoal for A L R W
apply (frule_tac A="𝒮" and B="𝒮'" and C="R" and x="W" in augment_mono_aux)
apply (frule_tac A="𝒮W R" and B="𝒮'W  R" and C="L" in restrict_mono_aux)
apply blast
done
done
done

lemma sharing_consistent_mono_owns:
"𝒪 𝒪' 𝒮.
  𝒪  𝒪'  sharing_consistent 𝒮 𝒪 sb  sharing_consistent 𝒮 𝒪' sb"
apply (induct sb)
apply simp
subgoal for a sb 𝒪 𝒪' 𝒮
apply (case_tac a)
apply    clarsimp
         subgoal for volatile a D f v A L R W
         apply (frule_tac A="𝒪" and B="𝒪'" and C="A" in union_mono_aux)
         apply (frule_tac A="𝒪  A" and B="𝒪'  A" and C="R" in set_minus_mono_aux)
         apply fastforce
         done
apply   clarsimp
apply  clarsimp
apply clarsimp
subgoal for A L R W
apply (frule_tac A="𝒪" and B="𝒪'" and C="A" in union_mono_aux)
apply (frule_tac A="𝒪  A" and B="𝒪'  A" and C="R" in set_minus_mono_aux)
apply fastforce
done
done
done


(* FIXME: move up *)
primrec all_shared :: "'a memref list  addr set"
where 
  "all_shared [] = {}"
| "all_shared (i#is) =
    (case i of
      Writesb volatile _ _ _ A L R W  (if volatile then R  all_shared is else all_shared is)
     | Ghostsb A L R W  R  all_shared is
     | _  all_shared is)"

lemma sharing_consistent_all_shared:
  "𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb  all_shared sb  dom 𝒮  𝒪"
  apply (induct sb)
  apply  clarsimp
  subgoal for a
  apply (case_tac a) 
  apply    (fastforce split: memref.splits if_split_asm)
  apply   clarsimp
  apply  clarsimp
  apply fastforce
  done
  done

lemma sharing_consistent_share_all_shared:
  "𝒮. dom (share sb 𝒮)  dom 𝒮  all_shared sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop t A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      from Cons.hyps [of "(𝒮W RA L)"]
      show ?thesis
        by (auto simp add: Writesb True)
    next
      case False with Cons Writesb show ?thesis by auto
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)
    from Cons.hyps [of "(𝒮W RA L)"]
    show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed




primrec all_unshared :: "'a memref list  addr set"
where 
  "all_unshared [] = {}"
| "all_unshared (i#is) =
    (case i of
      Writesb volatile _ _ _  A L R W  (if volatile then L  all_unshared is else all_unshared is)
     | Ghostsb A L R W  L  all_unshared is
     | _  all_unshared is)"

lemma all_unshared_append: "all_unshared (xs @ ys) = all_unshared xs  all_unshared ys"
  apply (induct xs)
  apply  simp
  subgoal for a
  apply (case_tac a)
  apply auto
  done
  done


lemma freshly_shared_owned:
  "𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb  dom (share sb 𝒮) - dom 𝒮  𝒪"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      with Cons Writesb show ?thesis by auto
    next
      case True
      from Cons.hyps [where 𝒮="(𝒮W RA L)" and 𝒪="(𝒪  A - R)"] Cons.prems
      show ?thesis
	by (auto simp add: Writesb True)
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)       
    with Cons.hyps [where 𝒮="(𝒮W RA L)" and 𝒪="(𝒪  A - R)"] Cons.prems show ?thesis by auto
  qed
qed

lemma unshared_all_unshared:
  "𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb  dom 𝒮 - dom (share sb 𝒮)  all_unshared sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      with Cons Writesb show ?thesis by auto
    next
      case True
      from Cons.hyps [where 𝒮="(𝒮W RA L)" and 𝒪="(𝒪  A - R)"] Cons.prems
      show ?thesis
	by (auto simp add: Writesb True)
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)       
    with Cons.hyps [where 𝒮="(𝒮W RA L)" and 𝒪="(𝒪  A - R)"] Cons.prems show ?thesis by auto
  qed
qed

lemma unshared_acquired_or_owned: 
  "𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb  all_unshared sb  all_acquired sb  𝒪"
  apply (induct sb)
  apply  simp
  subgoal for a
  apply (case_tac a)
  apply auto+
  done
  done

lemma all_shared_acquired_or_owned: 
  "𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb  all_shared sb  all_acquired sb  𝒪"
  apply (induct sb)
  apply  simp
  subgoal for a
  apply (case_tac a)
  apply auto+
  done
  done

(* FIXME: replace by thm sharing_consistent_shared_exchange? *)
lemma sharing_consistent_preservation:
"𝒮 𝒮' 𝒪. 
sharing_consistent 𝒮 𝒪 sb;
 all_acquired sb  dom 𝒮 - dom 𝒮' = {};
 all_unshared sb  dom 𝒮' - dom 𝒮 = {}
  sharing_consistent 𝒮' 𝒪 sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  have consis: "sharing_consistent 𝒮 𝒪 (x # sb)" by fact
  have removed_cond: "all_acquired (x # sb)  dom 𝒮 - dom 𝒮' = {}" by fact
  have new_cond: "all_unshared (x # sb)  dom 𝒮' - dom 𝒮 = {}" by fact
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False with Writesb Cons show ?thesis
	by auto
    next
      case True
      from consis obtain 
	A: "A  dom 𝒮  𝒪" and
	L: "L  A" and
        A_R: "A  R = {}" and
	R: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True)
      

      from removed_cond obtain rem_cond: "(A  all_acquired sb)  dom 𝒮  dom 𝒮'" by (clarsimp simp add: Writesb True)
      hence rem_cond': "all_acquired sb  dom (𝒮W RA L) - dom (𝒮'W RA L) = {}"
	by auto

      from new_cond obtain "(L  all_unshared sb)  dom 𝒮'  dom 𝒮" by (clarsimp simp add: Writesb True)
      hence new_cond': "all_unshared sb  dom (𝒮'W RA L) - dom (𝒮W RA L) = {}"     
	by auto
      
      from Cons.hyps [OF consis' rem_cond' new_cond']
      have "sharing_consistent (𝒮'W RA L) (𝒪  A - R) sb".
      moreover
      from A rem_cond have "A  dom 𝒮'  𝒪"
	by auto
      moreover note L A_R R
      ultimately show ?thesis
	by (auto simp add: Writesb True)
    qed
  next
    case (Ghostsb A L R W)
    from consis obtain 
      A: "A  dom 𝒮  𝒪" and
      L: "L  A" and
      A_R: "A  R = {}" and
      R: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb)
      

    from removed_cond obtain rem_cond: "(A  all_acquired sb)  dom 𝒮  dom 𝒮'" by (clarsimp simp add: Ghostsb)
    hence rem_cond': "all_acquired sb  dom (𝒮W RA L) - dom (𝒮'W RA L) = {}"
      by auto

    from new_cond obtain "(L  all_unshared sb)  dom 𝒮'  dom 𝒮" by (clarsimp simp add: Ghostsb)
    hence new_cond': "all_unshared sb  dom (𝒮'W RA L) - dom (𝒮W RA L) = {}"     
      by auto
      
    from Cons.hyps [OF consis' rem_cond' new_cond']
    have "sharing_consistent (𝒮'W RA L) (𝒪  A - R) sb".
    moreover
    from A rem_cond have "A  dom 𝒮'  𝒪"
      by auto
    moreover note L A_R R
    ultimately show ?thesis
      by (auto simp add: Ghostsb)
  qed (insert Cons, auto)
qed 

lemma (in sharing_consis) sharing_consis_preservation:
assumes dist: 
        "i < length ts. let (_,_,_,sb,_,_,_) = ts!i in 
          all_acquired sb  dom 𝒮 - dom 𝒮' = {}  all_unshared sb  dom 𝒮' - dom 𝒮 = {}"   
shows "sharing_consis 𝒮' ts"   
proof 
  fix i p "is" 𝒪  𝒟 θ sb
  assume i_bound: "i < length ts"
  assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
  show "sharing_consistent 𝒮' 𝒪 sb"
  proof -
    from sharing_consis [OF i_bound ts_i]
    have consis: "sharing_consistent 𝒮 𝒪 sb".
    from dist [rule_format, OF i_bound] ts_i
    obtain 
      acq: "all_acquired sb  dom 𝒮 - dom 𝒮' = {}" and
      uns: "all_unshared sb  dom 𝒮' - dom 𝒮 = {}"
      by auto
    from sharing_consistent_preservation [OF consis acq uns]
    show ?thesis .
  qed
qed

lemma (in sharing_consis) sharing_consis_shared_exchange:
assumes dist: 
        "i < length ts. let (_,_,_,sb,_,_,_) = ts!i in 
          a  all_acquired sb. 𝒮' a = 𝒮 a"   
shows "sharing_consis 𝒮' ts"   
proof 
  fix i p "is" 𝒪  𝒟 θ sb
  assume i_bound: "i < length ts"
  assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
  show "sharing_consistent 𝒮' 𝒪 sb"
  proof -
    from sharing_consis [OF i_bound ts_i]
    have consis: "sharing_consistent 𝒮 𝒪 sb".
    from dist [rule_format, OF i_bound] ts_i
    obtain 
      dist_sb: "a  all_acquired sb. 𝒮' a = 𝒮 a"
      by auto
    from sharing_consistent_shared_exchange [OF dist_sb consis]
    show ?thesis .
  qed
qed



lemma all_acquired_takeWhile: "all_acquired (takeWhile P sb)  all_acquired sb"
proof -
  from all_acquired_append [of "takeWhile P sb" "dropWhile P sb"] 
  show ?thesis
    by auto
qed

lemma all_acquired_dropWhile: "all_acquired (dropWhile P sb)  all_acquired sb"
proof -
  from all_acquired_append [of "takeWhile P sb" "dropWhile P sb"] 
  show ?thesis
    by auto
qed

lemma acquired_share_owns_shared:
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  shows "acquired pending_write sb 𝒪  dom (share sb 𝒮)  𝒪  dom 𝒮"
proof -
  from acquired_all_acquired have "acquired pending_write sb 𝒪  𝒪  all_acquired sb".
  moreover
  from sharing_consistent_all_acquired  [OF consis] have "all_acquired sb  dom 𝒮  𝒪".
  moreover
  from sharing_consistent_share_all_shared have "dom (share sb 𝒮)  dom 𝒮  all_shared sb".
  moreover
  from sharing_consistent_all_shared [OF consis] have "all_shared sb  dom 𝒮  𝒪".
  ultimately
  show ?thesis
    by blast
qed
   
lemma acquired_owns_shared:
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  shows "acquired True sb 𝒪  𝒪  dom 𝒮"
using acquired_share_owns_shared [OF consis]
by blast

lemma share_owns_shared:
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  shows "dom (share sb 𝒮)  𝒪  dom 𝒮"
using acquired_share_owns_shared [OF consis]
by blast

lemma all_shared_append: "all_shared (xs@ys) = all_shared xs  all_shared ys"
  by (induct xs) (auto split: memref.splits)

lemma acquired_union_notin_first:
  " pending_write A B. a  acquired pending_write sb (A  B)  a  A  a  acquired pending_write sb B"
proof (induct sb)
  case Nil thus ?case by (auto split: if_split_asm)
next
  case (Cons x sb)
  then obtain a_notin_A: "a  A" and
    a_acq: "a  acquired pending_write (x # sb) (A  B)" 
    by blast
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A' L R W)
    show ?thesis
    proof (cases volatile)
      case False
      with Writesb Cons show ?thesis by simp
    next
      case True
      note volatile = this
      show ?thesis
      proof (cases pending_write)
	case True
	from a_acq have a_acq': "a  acquired True sb (A  B  A' - R)"
	  by (simp add: Writesb volatile True)
	have "(A  B  A' - R)   (A  (B  A' - R))"
	  by auto
	from acquired_mono_in [OF a_acq' this]
	have "a  acquired True sb (A  (B  A' - R))".
	from Cons.hyps [OF this a_notin_A]

	have "a  acquired True sb (B  A' - R)".
	then
	show ?thesis by (simp add: Writesb volatile True)
      next
	case False
	from a_acq have a_acq': "a  acquired True sb (A' - R)"
	  by (simp add: Writesb volatile False)
	then
	show ?thesis
	  by (simp add: Writesb volatile False)
      qed
    qed
  next
    case (Ghostsb A' L R W)
    show ?thesis
    proof (cases pending_write)
      case True
      from a_acq have a_acq': "a  acquired True sb (A  B  A' - R)"
        by (simp add: Ghostsb True)
      have "(A  B  A' - R)   (A  (B  A' - R))"
        by auto
      from acquired_mono_in [OF a_acq' this]
      have "a  acquired True sb (A  (B  A' - R))".
      from Cons.hyps [OF this a_notin_A]

      have "a  acquired True sb (B  A' - R)".
      then
      show ?thesis by (simp add: Ghostsb True)
    next
      case False
      from a_acq have a_acq': "a  acquired False sb (A  B)"
	by (simp add: Ghostsb False)
      from Cons.hyps [OF this a_notin_A]
      show ?thesis
	by (simp add: Ghostsb False)
    qed
  qed (insert Cons, auto)
qed







(* FIXME: move up *)
lemma split_all_acquired_in:
"a  all_acquired xs 
(sop a' v ys zs A L R W. xs = ys @ Writesb True a' sop v A L R W# zs  a  A) 
 (A L R W ys zs. xs = ys @ Ghostsb A L R W# zs  a  A)"
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x xs)
  have a_in: "a  all_acquired (x # xs)" by fact
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      from a_in have "a  all_acquired xs"
	by (auto simp add: False Writesb)
      from Cons.hyps [OF this] 
      have "(sop a' v ys zs A L R W. xs = ys @ Writesb True a' sop v A L R W# zs  a  A) 
            (A L R W ys zs. xs = ys @ Ghostsb A L R W # zs  a  A)" (is "?write  ?ghst").
      then 
      show ?thesis
      proof 
	assume ?write
	then
	obtain sop'' a'' v'' A'' L'' R'' W'' ys zs
	  where "xs=ys@Writesb True a'' sop'' v'' A'' L'' R'' W''#zs" and a_in: "a  A''"
	  by auto
	hence "x#xs = (x#ys)@Writesb True a'' sop'' v'' A'' L'' R'' W''#zs"
	  by auto
	thus ?thesis
	  using a_in
	  by blast
      next
	assume ?ghst
	then obtain A'' L'' R'' W'' ys zs where
	  "xs=ys@Ghostsb A'' L'' R'' W''#zs" and a_in: "a  A''"
	  by auto
	hence "x#xs = (x#ys)@Ghostsb A'' L'' R'' W''#zs"
	  by auto
	thus ?thesis
	  using a_in
	  by blast
      qed
    next
      case True
      note volatile = this
      show ?thesis
      proof (cases "a  A")
	case False
	with a_in have "a  all_acquired xs"
	  by (auto simp add: volatile Writesb)
	from Cons.hyps [OF this] 
	have "(sop a' v ys zs A L R W. xs = ys @ Writesb True a' sop v A L R W # zs  a  A) 
              (A L R W ys zs. xs = ys @ Ghostsb A L R W# zs  a  A)" (is "?write  ?ghst").
	then 
	show ?thesis
	proof 
	  assume ?write
	  then
	  obtain sop'' a'' v'' A'' L'' R'' W'' ys zs
	    where "xs=ys@Writesb True a'' sop'' v'' A'' L'' R'' W'' #zs" and a_in: "a  A''"
	    by auto
	  hence "x#xs = (x#ys)@Writesb True a'' sop'' v'' A'' L'' R'' W''#zs"
	    by auto
	  thus ?thesis
	    using a_in
	    by blast
	next
	  assume ?ghst
	  then obtain A'' L'' R'' W'' ys zs where
	    "xs=ys @Ghostsb A'' L'' R'' W''#zs" and a_in: "a  A''"
	    by auto 
	  hence "x#xs  = (x#ys)@Ghostsb A'' L'' R'' W''#zs"
	    by auto
	  thus ?thesis
	    using a_in
	    by blast
	qed
      next
	case True
	then have "x#xs=[]@(Writesb True a' sop v A L R W#xs)"
	  by (simp add: Writesb volatile True)
	thus ?thesis
	  using True
	  by blast
      qed
    qed
  next
    case Readsb 
    from a_in have "a  all_acquired xs"
      by (auto simp add: Readsb)
    from Cons.hyps [OF this] 
    have "(sop a' v ys zs A L R W. xs = ys @ Writesb True a' sop v A L R W# zs  a  A) 
            (A L R W ys zs. xs = ys @ Ghostsb A L R W# zs  a  A)" (is "?write  ?ghst").
    then 
    show ?thesis
    proof 
      assume ?write
      then
      obtain sop'' a'' v'' A'' L'' R'' W'' ys zs
	where "xs=ys@Writesb True a'' sop'' v'' A'' L'' R'' W''#zs" and a_in: "a  A''"
	by auto
      hence "x#xs = (x#ys)@Writesb True a'' sop'' v'' A'' L'' R'' W''#zs"
	by auto
      thus ?thesis
	using a_in
	by blast
    next
      assume ?ghst
      then obtain A'' L'' R'' W'' ys zs where
	"xs=ys@Ghostsb A'' L'' R'' W''#zs" and a_in: "a  A''"
	by auto
      hence "x#xs = (x#ys)@Ghostsb A'' L'' R'' W''#zs"
	by auto
      thus ?thesis
	using a_in
	by blast
    qed
  next
    case Progsb
    from a_in have "a  all_acquired xs"
      by (auto simp add: Progsb)
    from Cons.hyps [OF this] 
    have "(sop a' v ys zs A L R W. xs = ys @ Writesb True a' sop v A L R W# zs  a  A) 
            (A L R W ys zs. xs = ys @ Ghostsb A L R W# zs  a  A)" (is "?write  ?ghst").
    then 
    show ?thesis
    proof 
      assume ?write
      then
      obtain sop'' a'' v'' A'' L'' R'' W'' ys zs
	where "xs=ys@Writesb True a'' sop'' v'' A'' L'' R'' W''#zs" and a_in: "a  A''"
	by auto
      hence "x#xs = (x#ys)@Writesb True a'' sop'' v'' A'' L'' R'' W''#zs"
	by auto
      thus ?thesis
	using a_in
	by blast
    next
      assume ?ghst
      then obtain A'' L'' R'' W'' ys zs where
	"xs=ys@Ghostsb A'' L'' R'' W''#zs" and a_in: "a  A''"
	by auto
      hence "x#xs = (x#ys)@Ghostsb A'' L'' R'' W''#zs"
	by auto
      thus ?thesis
	using a_in
	by blast
    qed
  next
    case (Ghostsb A L R W)
    show ?thesis
    proof (cases "a  A")
      case False
      with a_in have "a  all_acquired xs"
	by (auto simp add: Ghostsb)
      from Cons.hyps [OF this] 
      have "(sop a' v ys zs A L R W. xs = ys @ Writesb True a' sop v A L R W # zs  a  A) 
            (A L R W ys zs. xs = ys @ Ghostsb A L R W# zs  a  A)" (is "?write  ?ghst").
      then 
      show ?thesis
      proof 
	assume ?write
	then
	obtain sop'' a'' v'' A'' L'' R'' W'' ys zs
	  where "xs=ys@Writesb True a'' sop'' v'' A'' L'' R'' W''#zs" and a_in: "a  A''"
	  by auto
	hence "x#xs = (x#ys)@Writesb True a'' sop'' v'' A'' L'' R'' W''#zs"
	  by auto
	thus ?thesis
	  using a_in
	  by blast
      next
	assume ?ghst
	then obtain A'' L'' R'' W'' ys zs where
	  "xs=ys@Ghostsb A'' L'' R'' W''#zs" and a_in: "a  A''"
	  by auto
	hence "x#xs = (x#ys)@Ghostsb A'' L'' R'' W''#zs"
	  by auto
	thus ?thesis
	  using a_in
	  by blast
      qed
    next
      case True
      
      then have "x#xs=[]@(Ghostsb A L R W#xs)"
	by (simp add: Ghostsb True)
      thus ?thesis
	using True
	by blast
    qed
  qed
qed


lemma split_Writesb_in_outstanding_refs:
  "a  outstanding_refs is_Writesb xs  (sop volatile v ys zs A L R W. xs = ys@(Writesb volatile a sop v A L R W#zs))"
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x xs)
  have a_in: "a  outstanding_refs is_Writesb (x # xs)" by fact
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases "a'=a")
      case False
      with a_in have "a  outstanding_refs is_Writesb xs"
	by (auto simp add: Writesb)
      from Cons.hyps [OF this] obtain sop'' volatile'' v'' A'' L'' R'' W'' ys zs
	where "xs=ys@Writesb volatile'' a sop'' v'' A'' L'' R'' W''#zs"
	by auto
      hence "x#xs = (x#ys)@Writesb volatile'' a sop'' v'' A'' L'' R'' W''#zs"
	by auto
      thus ?thesis
	by blast
    next
      case True
      then have "x#xs=[]@(Writesb volatile a sop v A L R W#xs)"
	by (simp add: Writesb True)
      thus ?thesis
	by blast
    qed
  next
    case Readsb 
    from a_in have "a  outstanding_refs is_Writesb xs"
      by (auto simp add: Readsb)
    from Cons.hyps [OF this] obtain sop'' volatile'' v'' A'' L'' R'' W'' ys zs
      where "xs=ys@Writesb volatile'' a sop'' v'' A'' L'' R'' W'' #zs"
      by auto
    hence "x#xs = (x#ys)@Writesb volatile'' a sop'' v'' A'' L'' R'' W''#zs"
      by auto
    thus ?thesis
      by blast
  next
    case Progsb
    from a_in have "a  outstanding_refs is_Writesb xs"
      by (auto simp add: Progsb)
    from Cons.hyps [OF this] obtain sop'' volatile'' v'' A'' L'' R'' W'' ys zs
      where "xs=ys@Writesb volatile'' a sop'' v'' A'' L'' R'' W''#zs"
      by auto
    hence "x#xs = (x#ys)@Writesb volatile'' a sop'' v'' A'' L'' R'' W''#zs"
      by auto
    thus ?thesis
      by blast
  next
    case Ghostsb
    from a_in have "a  outstanding_refs is_Writesb xs"
      by (auto simp add: Ghostsb)
    from Cons.hyps [OF this] obtain sop'' volatile'' v'' A'' L'' R'' W'' ys zs
      where "xs=ys@Writesb volatile'' a sop'' v'' A'' L'' R'' W''#zs"
      by auto
    hence "x#xs = (x#ys)@Writesb volatile'' a sop'' v'' A'' L'' R'' W''#zs"
      by auto
    thus ?thesis
      by blast
  qed
qed

lemma outstanding_refs_is_Writesb_union:
  "outstanding_refs is_Writesb xs = 
    (outstanding_refs is_volatile_Writesb xs  outstanding_refs is_non_volatile_Writesb xs)"
apply (induct xs)
apply  simp
subgoal for a
apply (case_tac a)
apply auto
done
done

  
lemma rtranclp_r_rtranclp: "r** x y; r y z  r** x z"
  by auto

lemma r_rtranclp_rtranclp: "r x y; r** y z  r** x z"
  by auto

lemma unshared_is_non_volatile_Writesb: "𝒮.
  non_volatile_writes_unshared 𝒮 sb; a  dom 𝒮; a  all_unshared sb  
  a  outstanding_refs is_non_volatile_Writesb sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      with Cons Writesb show ?thesis by auto
    next
      case True
      from Cons.hyps [where 𝒮="(𝒮W RA L)" ] Cons.prems
      show ?thesis
	by (auto simp add: Writesb True)
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)       
    with Cons.hyps [where 𝒮="(𝒮W RA L)"] Cons.prems show ?thesis by auto
  qed
qed

lemma outstanding_non_volatile_Readsb_acquired_or_read_only_reads:
  "𝒪 𝒮 pending_write. 
  non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb;
 a  outstanding_refs is_non_volatile_Readsb sb
 a  acquired_reads True sb 𝒪  a  read_only_reads 𝒪 sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      with Writesb Cons.hyps [of True "(𝒮W RA L)" "(𝒪  A - R)"] Cons.prems
      show ?thesis by auto
    next
      case False
      with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case (Readsb volatile a' t v) 
    show ?thesis
    proof (cases volatile)
      case False with Readsb Cons show ?thesis by auto
    next
      case True
      with Readsb Cons show ?thesis by auto
    qed
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W) with Cons.hyps [of pending_write "(𝒮W RA L)" "𝒪  A - R"] Cons.prems
    show ?thesis
      by auto
  qed
qed

lemma acquired_reads_union: "pending_writes A B. 
  a  acquired_reads pending_writes sb (A  B); a  A  a  acquired_reads pending_writes sb B"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A' L' R' W')
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      show ?thesis
      proof (cases pending_writes)
	case True
	from Cons.prems obtain 
	  a_in: "a  acquired_reads True sb (A  B  A' - R')" and
	  a_notin: "a  A"
	  by (simp add: Writesb volatile True)
	have "(A  B  A' - R')   (A  (B  A' - R'))"
	  by auto
	from acquired_reads_mono [OF this ] a_in
	have "a  acquired_reads True sb (A  (B  A' - R'))"
	  by auto

	from Cons.hyps [OF this a_notin]
	have "a  acquired_reads True sb (B  A' - R')".
	then show ?thesis
	  by (simp add: Writesb volatile True)
      next
	case False
	with Cons show ?thesis
	  by (auto simp add: Writesb volatile False)
      qed
    next
      case False
      with Cons show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case Readsb with Cons show ?thesis
      by (auto split: if_split_asm)
  next
    case Progsb with Cons show ?thesis
      by (auto)
  next
    case (Ghostsb A' L' R' W')
    show ?thesis
    proof -
      from Cons.prems obtain 
	a_in: "a  acquired_reads pending_writes sb (A  B  A' - R')" and
	a_notin: "a  A"
        by (simp add: Ghostsb )
      have "(A  B  A' - R')   (A  (B  A' - R'))"
        by auto
      from acquired_reads_mono [OF this ] a_in
      have "a  acquired_reads pending_writes sb (A  (B  A' - R'))"
        by auto

      from Cons.hyps [OF this a_notin]
      have "a  acquired_reads pending_writes sb (B  A' - R')".
      then show ?thesis
        by (simp add: Ghostsb)
    qed
  qed
qed

   
lemma non_volatile_writes_unshared_no_outstanding_non_volatile_Writesb: "𝒮 𝒮'. 
  non_volatile_writes_unshared 𝒮 sb; 
  a  dom 𝒮' - dom 𝒮. a  outstanding_refs is_non_volatile_Writesb sb 
  non_volatile_writes_unshared 𝒮' sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
    proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      from Cons.prems obtain 
	unshared_sb: "non_volatile_writes_unshared (𝒮W RA L) sb" and
        no_refs_sb: "adom 𝒮' - dom 𝒮. a  outstanding_refs is_non_volatile_Writesb sb"
	by (simp add: Writesb True)
      from no_refs_sb have "adom (𝒮'W RA L) - dom (𝒮W RA L). 
	a  outstanding_refs is_non_volatile_Writesb sb"
	by auto
      from Cons.hyps [OF unshared_sb this]
      show ?thesis
	by (simp add: Writesb True)
    next
      case False
      with Cons show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case Readsb with Cons show ?thesis
      by (auto)
  next
    case Progsb with Cons show ?thesis
      by (auto)
  next
    case (Ghostsb A L R W) 
    from Cons.prems obtain 
      unshared_sb: "non_volatile_writes_unshared (𝒮W RA L) sb" and
      no_refs_sb: "adom 𝒮' - dom 𝒮. a  outstanding_refs is_non_volatile_Writesb sb"
      by (simp add: Ghostsb)
    from no_refs_sb have "adom (𝒮'W RA L) - dom (𝒮W RA L). 
      a  outstanding_refs is_non_volatile_Writesb sb"
      by auto
    from Cons.hyps [OF unshared_sb this]
    show ?thesis
      by (simp add: Ghostsb)
  qed
qed



theorem sharing_consis_share_all_until_volatile_write:
  "𝒮 ts'. ownership_distinct ts; sharing_consis 𝒮 ts; length ts' = length ts;
        i < length ts. 
              (let (_,_,_,sb,_,𝒪,_) = ts!i;
                   (_,_,_,sb',_,𝒪',_) = ts'!i 
               in 𝒪' = acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪  
                  sb' = dropWhile (Not  is_volatile_Writesb) sb) 
       sharing_consis (share_all_until_volatile_write ts 𝒮) ts' 
       dom (share_all_until_volatile_write ts 𝒮) - dom 𝒮  
           ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts) 
       dom 𝒮 - dom (share_all_until_volatile_write ts 𝒮)  
           ((λ(_,_,_,sb,_,𝒪,_). all_acquired sb  𝒪) ` set ts)"
proof (induct ts)
  case Nil thus ?case by auto
next
  case (Cons t ts)
  have leq: "length ts' = length (t#ts)" by fact
  have sim: "i < length (t#ts). 
              (let (_,_,_,sb,_,𝒪,_) = (t#ts)!i;
                   (_,_,_,sb',_,𝒪',_) = ts'!i 
               in 𝒪' = acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪  
                  sb' = dropWhile (Not  is_volatile_Writesb) sb)" 
    by fact
  obtain p "is" 𝒪  𝒟 θ sb 
    where t: "t = (p,is,θ,sb,𝒟,𝒪,)"
    by (cases t)

  from leq obtain t' ts'' where ts': "ts'=t'#ts''" and leq': "length ts'' = length ts"
    by (cases ts') force+
  
  obtain p' "is'" 𝒪' ℛ' 𝒟' θ' sb' 
    where t': "t' = (p',is',θ',sb',𝒟',𝒪',ℛ')"
    by (cases t')

  from sim [rule_format, of 0] t t' ts'
  obtain 𝒪': "𝒪' = acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪" and
         sb': "sb' = dropWhile (Not  is_volatile_Writesb) sb"
    by auto

  from sim ts'
  have sim': "i < length ts. 
              (let (_,_,_,sb,_,𝒪,) = ts!i;
                   (_,_,_,sb',_,𝒪',) = ts''!i 
               in 𝒪' = acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪  
                  sb' = dropWhile (Not  is_volatile_Writesb) sb)"
    by auto
    

  have consis: "sharing_consis 𝒮 (t#ts)" by fact
  then interpret sharing_consis 𝒮 "(t#ts)".
  from sharing_consis [of 0] t
  have consis_sb: "sharing_consistent 𝒮 𝒪 sb"
    by fastforce
  from sharing_consistent_takeWhile [OF this]
  have consis': "sharing_consistent 𝒮 𝒪 (takeWhile (Not  is_volatile_Writesb) sb)"
    by simp
  
  let ?𝒮' = "(share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮)"
  from freshly_shared_owned [OF consis']
  have fresh_owned: "dom ?𝒮' - dom 𝒮  𝒪".
  from unshared_all_unshared [OF consis'] unshared_acquired_or_owned [OF consis']
  have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
                  all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  𝒪"
    by simp

    
  have dist: "ownership_distinct (t#ts)" by fact
  from ownership_distinct_tl [OF this]
  have dist': "ownership_distinct ts" .

  
  from sharing_consis_tl [OF consis]
  interpret consis': sharing_consis 𝒮 "ts".
    

  from dist interpret ownership_distinct "(t#ts)".

  (* FIXME: this proof appears in several times. Maybe make a lemma *)
  have sep: 
    "i < length ts. let (_,_,_,sb',_,_,_) = ts!i in 
          all_acquired sb'  dom 𝒮 - dom ?𝒮' = {}  
          all_unshared sb'  dom ?𝒮' - dom 𝒮 = {}"
  proof -
    {
      fix i pi "isi" 𝒪i i 𝒟i θi sbi
      assume i_bound: "i < length ts"
      assume ts_i: "ts ! i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
      have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}  
            all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
      proof -
	from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
	have dist: "(𝒪  all_acquired sb)  (𝒪i  all_acquired sbi) = {}"
	  by force


	from dist unshared_acq_owned all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" sb]
	have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}"
	  by blast

	moreover
	
	from sharing_consis [of "Suc i"] ts_i i_bound
	have "sharing_consistent 𝒮 𝒪i sbi"
	  by force
	from unshared_acquired_or_owned [OF this]
	have "all_unshared sbi  all_acquired sbi  𝒪i".      
	with dist fresh_owned
	have "all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
	  by blast
      
	ultimately show ?thesis by simp
      qed
    }
    thus ?thesis
      by (fastforce simp add: Let_def)
  qed

      
      
  from consis'.sharing_consis_preservation [OF sep]
  have consis_ts: "sharing_consis ?𝒮' ts".


  from Cons.hyps [OF dist' this leq' sim']
  obtain consis_ts'':
    "sharing_consis (share_all_until_volatile_write ts ?𝒮') ts''" and

    fresh: "dom (share_all_until_volatile_write ts ?𝒮') - dom ?𝒮'  
            ((λ(_,_,_,_,_,𝒪,).  𝒪) ` set ts)" and
    unshared: "dom ?𝒮' - dom (share_all_until_volatile_write ts ?𝒮')  
           ((λ(_,_,_,sb,_,𝒪,). all_acquired sb  𝒪)` set ts)"
    by auto


  from sharing_consistent_append [of _ _ "(takeWhile (Not  is_volatile_Writesb) sb)" 
  "(dropWhile (Not  is_volatile_Writesb) sb)"] consis_sb
  have consis_t': "sharing_consistent ?𝒮' 𝒪' sb'"
    by (simp add: 𝒪' sb')


  have fresh_dist: "all_acquired sb'  dom ?𝒮' - dom (share_all_until_volatile_write ts ?𝒮') = {}"
  proof -
    have "all_acquired sb'   ((λ(_,_,_,sb,_,𝒪,_). all_acquired sb  𝒪)` set ts) = {}"
    proof -
      {
	fix x
	assume x_sb': "x  all_acquired sb'"
	assume x_ts: "x   ((λ(_,_,_,sb,_,𝒪,_). all_acquired sb  𝒪)` set ts)"
	have False
	proof -
	  from x_ts
	  obtain i pi isi 𝒪i i 𝒟i θi sbi where 
	    i_bound: "i < length ts" and
            ts_i: "ts!i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)" and
	    x_in: "x  all_acquired sbi  𝒪i"
	    by (force simp add:  in_set_conv_nth)
	  from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
	  have dist: "(𝒪  all_acquired sb)  (𝒪i  all_acquired sbi) = {}"
	    by force
	  with x_sb' x_in all_acquired_dropWhile [of "(Not  is_volatile_Writesb)" "sb"] show False
	    by (auto simp add: sb')
	qed
      }
      thus ?thesis by blast
    qed
    with unshared show ?thesis
      by blast
  qed

  have unshared_dist: "all_unshared sb'  dom (share_all_until_volatile_write ts ?𝒮') - dom ?𝒮' = {}"
  proof -
    from unshared_acquired_or_owned [OF consis_t']
    have "all_unshared sb'  all_acquired sb'  𝒪'".
    also
    from all_acquired_dropWhile [of "(Not  is_volatile_Writesb)" "sb"]
    acquired_all_acquired [of True "takeWhile (Not  is_volatile_Writesb) sb" 𝒪]
    all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" "sb"]
    have "all_acquired sb'  𝒪'  all_acquired sb  𝒪"
      by (auto simp add: sb' 𝒪')
    finally
    have "all_unshared sb'  (all_acquired sb  𝒪)".

    moreover

    have "(all_acquired sb  𝒪)   ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts) = {}"
    proof -
      {
	fix x
	assume x_sb': "x  all_acquired sb  𝒪"
	assume x_ts: "x   ((λ(_,_,_,_,_,𝒪,_). 𝒪)` set ts)"
	have False
	proof -
	  from x_ts
	  obtain i pi isi 𝒪i i 𝒟i θi sbi where 
	    i_bound: "i < length ts" and
            ts_i: "ts!i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)" and
	    x_in: "x  𝒪i"
	    by (force simp add:  in_set_conv_nth)
	  from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
	  have dist: "(𝒪  all_acquired sb)  (𝒪i  all_acquired sbi) = {}"
	    by force
	  with x_sb' x_in show False
	    by (auto simp add: sb')
	qed
      }
      thus ?thesis by blast
    qed
    ultimately show ?thesis
      using fresh by fastforce
  qed

  from sharing_consistent_preservation [OF consis_t' fresh_dist unshared_dist]
  have consis_ts: "sharing_consistent (share_all_until_volatile_write ts ?𝒮') 𝒪' sb'".
  note sharing_consis_Cons [OF consis_ts'' consis_ts, of p' is' θ' 𝒟' ]
  moreover
  from fresh fresh_owned
  have "dom (share_all_until_volatile_write ts ?𝒮') - dom 𝒮  
          𝒪   ((λ(_,_,_,_,_,𝒪,_).  𝒪) ` set ts)"  
    by auto
  moreover
  from unshared unshared_acq_owned all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" sb]
  have "dom 𝒮 - dom (share_all_until_volatile_write ts ?𝒮')  
          all_acquired sb  𝒪   ((λ(_,_,_,sb,_,𝒪,_). all_acquired sb  𝒪) ` set ts)"
    by auto
  ultimately

  show ?case
    by (auto simp add: t ts' t')
qed


corollary sharing_consistent_share_all_until_volatile_write: 
assumes dist: "ownership_distinct ts" 
assumes consis: "sharing_consis 𝒮 ts" 
assumes i_bound: "i < length ts" 
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)" 
shows "sharing_consistent (share_all_until_volatile_write ts 𝒮) 
                          (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪) 
                          (dropWhile (Not  is_volatile_Writesb) sb)"
proof -
  define ts' where "ts' == map (λ(p,is,θ,sb,𝒟,𝒪,).  
                    (p,is,θ,
                          dropWhile (Not  is_volatile_Writesb) sb,𝒟,acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪,)) ts"
  have leq: "length ts' = length ts"
    by (simp add: ts'_def)

  have flush: "i < length ts. 
              (let (_,_,_,sb,_,𝒪,_) = ts!i;
                   (_,_,_,sb',_,𝒪',_) = ts'!i 
               in 𝒪' = acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪  
                  sb' = dropWhile (Not  is_volatile_Writesb) sb)"
    by (auto simp add: ts'_def Let_def)

  from sharing_consis_share_all_until_volatile_write [OF dist consis leq flush]
  interpret sharing_consis "(share_all_until_volatile_write ts 𝒮)" "ts'" by simp
  from i_bound leq ts_i sharing_consis [of i]
  show ?thesis
    by (force simp add: ts'_def)
qed



lemma restrict_map_UNIV [simp]: "S |` UNIV = S"
  by (auto simp add: restrict_map_def)

(*
lemma share_takeWhile_non_volatile_Writesb: 
  "⋀S.  (share (takeWhile (Not ∘ is_volatile_Writesb) sb) S) =
  S ⊖(all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sb)) (all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb))"
apply (induct sb)
apply  simp
apply (case_tac a)
apply (auto intro: share_mono_in simp add: restrict_shared_fuse)
done
*)

(*
lemma dom_share_takeWhile_non_volatile_Writesb: 
  "dom (share (takeWhile (Not ∘ is_volatile_Writesb) sb) S) = dom S - all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)"
  apply (auto simp add: share_takeWhile_non_volatile_Writesb)
  done
*)
(*
lemma dom_share_takeWhile_non_volatile_Writesb: 
  "⋀S.  dom (share (takeWhile (Not ∘ is_volatile_Writesb) sb) S) ⊆ dom S - all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)"
apply (induct sb)
apply  simp
apply (case_tac a)
apply (auto intro: share_mono_in simp add: restrict_shared_fuse)
  apply (auto simp add: )
  done
*)
lemma share_all_until_volatile_write_Read_commute:
  shows "S i.  i < length ls; ls!i=(p,Read volatile a t#is,θ,sb,𝒟,𝒪)
      
    
    share_all_until_volatile_write 
       (ls[i := (p,is, θ(tv), sb @ [Readsb volatile a t v],𝒟', 𝒪)]) S =
    share_all_until_volatile_write ls S"
proof (induct ls)
  case Nil thus ?case
    by simp
next
  case (Cons l ls)
  note i_bound =  i < length (l#ls)
  note ith = (l#ls)!i = (p,Read volatile a t#is,θ,sb,𝒟,𝒪)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,Read volatile a t#is,θ,sb,𝒟,𝒪)"
      by simp
    thus ?thesis 
      by (simp add: 0 share_append_Readsb del: fun_upd_apply )
  next
    case (Suc n)
    obtain pl "isl" 𝒪l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l)"
      by (cases l)
    from i_bound ith
    have "share_all_until_volatile_write
      (ls[n := (p,is, θ(tv), sb @ [Readsb volatile a t v],𝒟', 𝒪)]) 
      (share (takeWhile (Not  is_volatile_Writesb) sbl) S) =
      share_all_until_volatile_write ls (share (takeWhile (Not  is_volatile_Writesb) sbl) S)"
      apply -
      apply (rule Cons.hyps)
      apply (auto simp add: Suc l)
      done
    
    then
    show ?thesis
      by (simp add: Suc l del: fun_upd_apply)
  qed
qed

lemma share_all_until_volatile_write_Write_commute:
  shows "S i.  i < length ls; ls!i=(p,Write volatile a (D,f) A L R W#is,θ,sb,𝒟,𝒪)
      
    
    share_all_until_volatile_write 
       (ls[i := (p,is,θ, sb @ [Writesb volatile a t (f θ) A L R W], 𝒟', 𝒪)]) S =
    share_all_until_volatile_write ls S"
proof (induct ls)
  case Nil thus ?case
    by simp
next
  case (Cons l ls)
  note i_bound =  i < length (l#ls)
  note ith = (l#ls)!i = (p,Write volatile a (D,f) A L R W#is,θ,sb,𝒟,𝒪)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,Write volatile a (D,f) A L R W#is,θ,sb,𝒟,𝒪)"
      by simp
    thus ?thesis 
      by (simp add: 0 share_append_Writesb del: fun_upd_apply )
  next
    case (Suc n)
    obtain pl "isl" 𝒪l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l)"
      by (cases l)
    from i_bound ith
    have "share_all_until_volatile_write
      (ls[n := (p,is, θ, sb @ [Writesb volatile a t (f θ) A L R W],𝒟', 𝒪)]) 
      (share (takeWhile (Not  is_volatile_Writesb) sbl) S) =
      share_all_until_volatile_write ls (share (takeWhile (Not  is_volatile_Writesb) sbl) S)"
      apply -
      apply (rule Cons.hyps)
      apply (auto simp add: Suc l)
      done
    
    then
    show ?thesis
      by (simp add: Suc l del: fun_upd_apply)
  qed
qed

lemma share_all_until_volatile_write_RMW_commute:
  shows "S i.  i < length ls; ls!i=(p,RMW a t (D,f) cond ret A L R W#is,θ,[],𝒟,𝒪)
      
    
    share_all_until_volatile_write (ls[i := (p',is, θ', [],𝒟', 𝒪')]) S =
    share_all_until_volatile_write ls S"
proof (induct ls)
  case Nil thus ?case
    by simp
next
  case (Cons l ls)
  note i_bound =  i < length (l#ls)
  note ith = (l#ls)!i = (p,RMW a t (D,f) cond ret A L R W#is,θ,[],𝒟,𝒪)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,RMW a t (D,f) cond ret A L R W#is,θ,[],𝒟,𝒪)"
      by simp
    thus ?thesis 
      by (simp add: 0 share_append_Writesb del: fun_upd_apply )
  next
    case (Suc n)
    obtain pl "isl" 𝒪l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l)"
      by (cases l)
    from i_bound ith
    have "share_all_until_volatile_write
      (ls[n := (p',is,θ', [], 𝒟', 𝒪')]) 
      (share (takeWhile (Not  is_volatile_Writesb) sbl) S) =
      share_all_until_volatile_write ls (share (takeWhile (Not  is_volatile_Writesb) sbl) S)"
      apply -
      apply (rule Cons.hyps)
      apply (auto simp add: Suc l)
      done
    
    then
    show ?thesis
      by (simp add: Suc l del: fun_upd_apply)
  qed
qed

lemma share_all_until_volatile_write_Fence_commute:
  shows "S i.  i < length ls; ls!i=(p,Fence#is,θ,[],𝒟,𝒪,)
      
    
    share_all_until_volatile_write (ls[i := (p,is,θ, [], 𝒟', 𝒪,ℛ')]) S =
    share_all_until_volatile_write ls S"
proof (induct ls)
  case Nil thus ?case
    by simp
next
  case (Cons l ls)
  note i_bound =  i < length (l#ls)
  note ith = (l#ls)!i = (p,Fence#is,θ,[],𝒟,𝒪,)
  show ?case
  proof (cases i)
    case 0
    from ith 0 have l: "l = (p,Fence#is,θ,[],𝒟,𝒪,)"
      by simp
    thus ?thesis 
      by (simp add: 0 share_append_Writesb del: fun_upd_apply )
  next
    case (Suc n)
    obtain pl "isl" 𝒪l l 𝒟l θl sbl where l: "l = (pl,isl,θl,sbl,𝒟l,𝒪l,l)"
      by (cases l)
    from i_bound ith
    have "share_all_until_volatile_write
      (ls[n := (p,is, θ, [],𝒟', 𝒪,ℛ')]) 
      (share (takeWhile (Not  is_volatile_Writesb) sbl) S) =
      share_all_until_volatile_write ls (share (takeWhile (Not  is_volatile_Writesb) sbl) S)"
      apply -
      apply (rule Cons.hyps)
      apply (auto simp add: Suc l)
      done
    
    then
    show ?thesis
      by (simp add: Suc l del: fun_upd_apply)
  qed
qed



(*
lemma unshared_share_takeWhile:  
  assumes unshared: "non_volatile_writes_unshared 𝒮 xs"
  shows "non_volatile_writes_unshared (share (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒮) xs"
proof -
  from share_takeWhile_non_volatile_Writesb [of sb 𝒮]
  have "dom (share (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒮) ⊆ dom 𝒮"
    by auto
  from non_volatile_writes_unshared_antimono [OF this unshared]
  show ?thesis
    by simp
qed
*)
(*
lemma non_volatile_writes_unshared_share_all_until_volatile_write: "⋀𝒮. non_volatile_writes_unshared 𝒮 xs ⟹ 
       non_volatile_writes_unshared (share_all_until_volatile_write ts 𝒮) xs"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  obtain p "is" 𝒪 𝒟 θ sb where t: "t=(p,is,θ,sb,𝒟,𝒪)"
    by (cases t) 

  from unshared_share_takeWhile [OF Cons.prems]
  have "non_volatile_writes_unshared (share (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒮) xs".
  from Cons.hyps [OF this]
  show ?case
    by (simp add: t)
qed
*)
(*
lemma share_takeWhile_non_volatile_Writesb_restrict:
  "dom (share (takeWhile (Not ∘ is_volatile_Writesb) sb) S) ⊆ dom S"
  apply (auto simp add: share_takeWhile_non_volatile_Writesb)
  done
*)

(*
lemma share_all_until_volatile_write_restrict:
  "⋀S. dom (share_all_until_volatile_write ts S) ⊆ dom S"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  obtain p "is" 𝒪 𝒟 θ sb where t: "t=(p,is,θ,sb,𝒟,𝒪)"
    by (cases t) 

  from share_takeWhile_non_volatile_Writesb_restrict
  have "dom (share (takeWhile (Not ∘ is_volatile_Writesb) sb) S) ⊆ dom S".
  with Cons.hyps
  show ?case
    by (auto simp add: t)
qed
*)
(*
lemma share_all_until_volatile_all_unshared:
  "⋀S. dom (share_all_until_volatile_write ts S) = 
        dom S - ⋃(λ(_,_,_,sb,_,_,_). all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)) ` set ts"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  obtain p "is" 𝒪 ℛ 𝒟 θ sb where t: "t=(p,is,θ,sb,𝒟,𝒪,ℛ)"
    by (cases t) 
  from Cons.hyps 
  have "dom (share_all_until_volatile_write ts (share (takeWhile (Not ∘ is_volatile_Writesb) sb) S)) = 
          dom (share (takeWhile (Not ∘ is_volatile_Writesb) sb) S) 
           - ⋃(λ(_,_,_,sb,_,_,_). all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)) ` set ts".
  moreover
  from dom_share_takeWhile_non_volatile_Writesb
  have "dom (share (takeWhile (Not ∘ is_volatile_Writesb) sb) S) = dom S - all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)".
  ultimately
  have "dom (share_all_until_volatile_write (t#ts) S) = 
       dom S - all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb) - 
       ⋃(λ(_,_,_,sb,_,_). all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)) ` set ts"
    by (simp add: t)
  also
  have "… = dom S - ⋃(λ(_,_,_,sb,_,_). all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)) ` set (t#ts)"
    by (auto simp add: t)
  finally
  show ?case
    by (auto simp del: o_apply)
qed
    
lemma share_all_until_volatile_all_unshared_i:
  assumes i_bound: "i < length ts" 
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪)"
  assumes a_in: "a ∈ dom (share_all_until_volatile_write ts S)" 
  shows "a ∉ all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)"
proof -
  from nth_mem [OF i_bound]  ts_i have "(p,is,θ,sb,𝒟,𝒪) ∈ set ts"
    by auto
  with a_in
  show ?thesis
    by (auto simp add: share_all_until_volatile_all_unshared)
qed
*)
    
lemma unshared_share_in: "S. a  dom S  a   all_unshared sb  a  dom (share sb S)"
proof (induct sb)
    case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      show ?thesis
      proof -
	from Cons.prems obtain a_S: "a  dom S" and a_L: "a  L" and  a_sb: "a  all_unshared sb" 
	  by (clarsimp simp add: Writesb True)
	from a_S a_L have "a  dom (SW RA L)"
	  by auto
	from Cons.hyps [OF this a_sb]
	show ?thesis  
	  by (clarsimp simp add: Writesb True)
      qed
    next
      case False
      with Cons show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case Readsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case Progsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case Ghostsb
    with Cons show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed


lemma dom_eq_dom_share_eq: "S S'. dom S = dom S'  dom (share sb S) = dom (share sb S')"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A' L R W)
    show ?thesis
    proof (cases volatile)
      case True
      from Cons.prems
      have "dom (SW RA' L) = dom (S'W RA' L)"
	by auto
      from Cons.hyps [OF this]
      show ?thesis
	by (clarsimp simp add: Writesb True)
    next
      case False with Cons.hyps [of S S'] Cons.prems Writesb show ?thesis by auto
    qed
  next
    case Readsb with Cons.hyps [of S S'] Cons.prems show ?thesis by auto
  next
    case Progsb with Cons.hyps [of S S'] Cons.prems show ?thesis by auto
  next
    case (Ghostsb A' L R W)
    from Cons.prems
    have "dom (SW RA' L) = dom (S'W RA' L)"
      by auto
    from Cons.hyps [OF this]
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed
   
lemma share_union:
  "A B. a  dom (share sb (Az B)); a  dom A  a  dom (share sb (Map.empty ⊕z B))"
proof (induct sb)
    case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A' L R W)
    show ?thesis
    proof (cases volatile)
      case True
      from Cons.prems 
      obtain a_in: "a  dom (share sb ((Az B)W RA' L))" and a_A: "a  dom A"
	by (clarsimp simp add: Writesb True)
      have "dom ((Az B)W RA' L)  dom (Az (B  R - L))"
	by auto
      from share_mono [OF this] a_in
      have "a  dom (share sb (Az (B  R - L)))"
	by blast
      from Cons.hyps [OF this] a_A
      have "a  dom (share sb (Map.empty ⊕z (B  R - L)))"
	by blast
      moreover
      have "dom (Map.empty ⊕z B  R - L) = dom ((Map.empty ⊕z B)W RA' L)"
	by auto
      note dom_eq_dom_share_eq [OF this, of sb]
      ultimately
      show ?thesis
	by (clarsimp simp add: Writesb True)
    next
      case False
      with Cons show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case Readsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case Progsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case (Ghostsb A' L R W)
    from Cons.prems 
    obtain a_in: "a  dom (share sb ((Az B)W RA' L))" and a_A: "a  dom A"
      by (clarsimp simp add: Ghostsb)
    have "dom ((Az B)W RA' L)  dom (Az (B  R - L))"
      by auto
    from share_mono [OF this] a_in
    have "a  dom (share sb (Az (B  R - L)))"
      by blast
    from Cons.hyps [OF this] a_A
    have "a  dom (share sb (Map.empty ⊕z (B  R - L)))"
      by blast
    moreover
    have "dom (Map.empty ⊕z B  R - L) = dom ((Map.empty ⊕z B)W RA' L)"
      by auto
    note dom_eq_dom_share_eq [OF this, of sb]
    ultimately
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed

   
lemma share_unshared_in: 
  "S. a  dom (share sb S)  a  dom (share sb Map.empty)  (a  dom S  a  all_unshared sb)"
proof (induct sb)
    case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems
      have a_in: "a  dom (share sb (SW RA L))"
	by (clarsimp simp add: Writesb True)
      show ?thesis
      proof (cases "a  dom S")
	case True
	from Cons.hyps [OF a_in]
	have "a  dom (share sb Map.empty)  a  dom (SW RA L)  a  all_unshared sb".
	then show ?thesis
	proof 
	  assume "a  dom (share sb Map.empty)"
	  from share_mono_in [OF this]
	  have "a  dom (share sb (Map.empty ⊕W RA L))" by auto
	  then show ?thesis
	    by (clarsimp simp add: Writesb volatile True)
	next
	  assume "a  dom (SW RA L)  a  all_unshared sb"
	  then obtain "a  L" "a  all_unshared sb"
	    by auto
	  then show ?thesis by (clarsimp simp add: Writesb volatile True)
	qed
      next
	case False
	have "dom (SW RA L)  dom (SW (R - L))"
	  by auto
	from share_mono [OF this] a_in
	have "a  dom (share sb (SW  (R - L)))" by blast
	from share_union [OF this False]
	have "a  dom (share sb (Map.empty ⊕W (R - L)))".
	moreover
	have "dom (Map.empty ⊕W (R - L)) = dom (Map.empty ⊕W RA L)"
	  by auto
	note dom_eq_dom_share_eq [OF this, of sb]
	ultimately
	show ?thesis
	  by (clarsimp simp add: Writesb True)
      qed
    next
      case False
      with Cons show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case Readsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case Progsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case (Ghostsb A L R W)
    from Cons.prems
    have a_in: "a  dom (share sb (SW RA L))"
      by (clarsimp simp add: Ghostsb)
    show ?thesis
    proof (cases "a  dom S")
      case True
      from Cons.hyps [OF a_in]
      have "a  dom (share sb Map.empty)  a  dom (SW RA L)  a  all_unshared sb".
      then show ?thesis
      proof 
	assume "a  dom (share sb Map.empty)"
	from share_mono_in [OF this]
	have "a  dom (share sb (Map.empty ⊕W RA L))" by auto
        then show ?thesis
	  by (clarsimp simp add: Ghostsb True)
      next
	assume "a  dom (SW RA L)  a  all_unshared sb"
	then obtain "a  L" "a  all_unshared sb"
	  by auto
	then show ?thesis by (clarsimp simp add: Ghostsb True)
      qed
    next
      case False
      have "dom (SW RA L)  dom (SW (R - L))"
        by auto
      from share_mono [OF this] a_in
      have "a  dom (share sb (SW  (R - L)))" by blast
      from share_union [OF this False]
      have "a  dom (share sb (Map.empty ⊕W (R - L)))".
      moreover
      have "dom (Map.empty ⊕W (R - L)) = dom (Map.empty ⊕W RA L)"
        by auto
      note dom_eq_dom_share_eq [OF this, of sb]
      ultimately
      show ?thesis
        by (clarsimp simp add: Ghostsb False)
    qed
  qed
qed

(* FIXME: move up *)
lemma dom_augment_rels_shared_eq: "dom (augment_rels S R ) = dom (augment_rels S' R )"
  by (auto simp add: augment_rels_def domIff split: option.splits if_split_asm)

lemma dom_eq_SomeD1: "dom m = dom n  m x = Some y  n x  None"
  by (auto simp add: dom_def)

lemma dom_eq_SomeD2: "dom m = dom n  n x = Some y  m x  None"
  by (auto simp add: dom_def)

lemma dom_augment_rels_rels_eq: "dom ℛ'  = dom   dom (augment_rels S R ℛ') = dom (augment_rels S R )"
  by (auto simp add: augment_rels_def domIff split: option.splits if_split_asm dest: dom_eq_SomeD1 dom_eq_SomeD2)


lemma dom_release_rels_eq: "𝒮  ℛ'. dom ℛ' = dom   
  dom (release sb 𝒮 ℛ') = dom (release sb 𝒮 )"
proof (induct sb)
  case Nil thus ?case by simp
next 
  case (Cons x sb)
  hence dr: "dom ℛ' = dom "
    by simp
  show ?case
  proof (cases x)
    case Writesb with Cons.hyps [OF dr] show ?thesis by (clarsimp)
  next 
    case Readsb with Cons.hyps [OF dr] show ?thesis by (clarsimp)
  next 
    case Progsb with Cons.hyps [OF dr] show ?thesis by (clarsimp)
  next
    case (Ghostsb A L R W)
    from Cons.hyps [OF dom_augment_rels_rels_eq [OF dr]]
    show ?thesis
     by (simp add: Ghostsb)
 qed
qed



lemma dom_release_shared_eq: "𝒮 𝒮' . dom (release sb 𝒮' ) = dom (release sb 𝒮 )"
proof (induct sb)
  case Nil thus ?case by simp
next 
  case (Cons x sb)
  show ?case
  proof (cases x)
    case Writesb with Cons.hyps show ?thesis by (clarsimp)
  next 
    case Readsb with Cons.hyps show ?thesis by (clarsimp)
  next 
    case Progsb with Cons.hyps show ?thesis by (clarsimp)
  next
    case (Ghostsb A L R W)
    have dr: "dom (augment_rels 𝒮' R ) = dom (augment_rels 𝒮 R )"
      by(rule dom_augment_rels_shared_eq)
    have "dom (release sb (𝒮'  R - L) (augment_rels 𝒮' R )) =
          dom (release sb (𝒮  R - L) (augment_rels 𝒮' R ))"
      by (rule Cons.hyps)
    also have "... = dom (release sb (𝒮  R - L) (augment_rels 𝒮 R ))"
      by (rule dom_release_rels_eq [OF dr])
    finally show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed


lemma share_other_untouched:
  "𝒪 𝒮. sharing_consistent 𝒮 𝒪 sb  a  𝒪  all_acquired sb share sb 𝒮 a = 𝒮 a"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True

      from Cons.prems obtain 
	A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and 
        a_owns: "a  𝒪" and a_A: "a  A" and a_sb: "a  all_acquired sb"
	by ( simp add: Writesb True )

      from a_owns a_A a_sb 
      have "a  𝒪  A - R  all_acquired sb"
        by auto
      from Cons.hyps [OF consis' this]
      have "share sb (𝒮W RA L) a = (𝒮W RA L) a".
      moreover have "(𝒮W RA L) a = 𝒮 a"
      using L_A A_R R_owns a_owns a_A
        by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
      ultimately show ?thesis
        by (simp add: Writesb True)
    next
      case False with Cons show ?thesis
        by (auto simp add: Writesb False)
    qed
  next
    case Readsb with Cons
    show ?thesis
      by (auto)
  next
    case Progsb with Cons
    show ?thesis
      by (auto)
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and 
      a_owns: "a  𝒪" and a_A: "a  A" and a_sb: "a  all_acquired sb"
      by ( simp add: Ghostsb )

    from a_owns a_A a_sb 
    have "a  𝒪  A - R  all_acquired sb"
      by auto
    from Cons.hyps [OF consis' this]
    have "share sb (𝒮W RA L) a = (𝒮W RA L) a".
    moreover have "(𝒮W RA L) a = 𝒮 a"
    using L_A A_R R_owns a_owns a_A
      by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
    ultimately show ?thesis
      by (simp add: Ghostsb)
  qed
qed

lemma shared_owned: "𝒪 𝒮. sharing_consistent 𝒮 𝒪 sb  a  dom 𝒮  a  dom (share sb 𝒮)  
    a  𝒪  all_acquired sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True

      from Cons.prems obtain 
	A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and 
        a_notin: "a  dom 𝒮" and a_in: "a  dom (share sb (𝒮W RA L))"
	by ( simp add: Writesb True )
      
      show ?thesis
      proof (cases "a  𝒪")
        case True thus ?thesis by auto
      next
        case False
        with a_notin R_owns A_shared_owns L_A A_R have "a  dom (𝒮W RA L)"
          by (auto)
        from Cons.hyps [OF consis' this a_in]
        show ?thesis
          by (auto simp add: Writesb True)
      qed
    next
      case False with Cons show ?thesis
        by (auto simp add: Writesb False)
    qed
  next
    case Readsb with Cons
    show ?thesis
      by (auto)
  next
    case Progsb with Cons
    show ?thesis
      by (auto)
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and 
      a_notin: "a  dom 𝒮" and a_in: "a  dom (share sb (𝒮W RA L))"
      by (simp add: Ghostsb)
      
    show ?thesis
    proof (cases "a  𝒪")
      case True thus ?thesis by auto
    next
      case False
      with a_notin R_owns A_shared_owns L_A A_R have "a  dom (𝒮W RA L)"
        by (auto)
      from Cons.hyps [OF consis' this a_in]
      show ?thesis
        by (auto simp add: Ghostsb)
    qed
  qed
qed

(*
      sharing consistent:
      a ∈ dom (share (takeWhile (Not ∘ is_volatile_Writesb) (sb!i)) empty)
      ⟹ a ∈ dom (share_all_until_volatile_write ts 𝒮)
(it should even be the same boolean value )
generalization

      a ∉ dom S ⟹
      a ∈ dom (share (takeWhile (Not ∘ is_volatile_Writesb) (sb!i)) S)
      ⟹ a ∈ dom (share_all_until_volatile_write ts S')

also generalize freshly_shared_owned; cf. share_owns_shared

if a is owned by a thread, no other thread can mess around with sharing!


a ∉ 𝒪; sharing_consistent 𝒮 𝒪 sb;
share sb 𝒮 a = share a
*)

(* FIXME: move up *)
lemma share_all_shared_in: "a  dom (share sb 𝒮)  a  dom 𝒮  a  all_shared sb"
using sharing_consistent_share_all_shared [of sb 𝒮]
  by auto

lemma share_all_until_volatile_write_unowned:
  assumes dist: "ownership_distinct ts"
  assumes consis: "sharing_consis 𝒮 ts"
  assumes other: "i p is θ sb 𝒟 𝒪 . i < length ts  ts!i = (p,is,θ,sb,𝒟,𝒪,) 
              a  𝒪  all_acquired sb"
  shows "share_all_until_volatile_write ts 𝒮 a = 𝒮 a"
using dist consis other 
proof (induct ts arbitrary: 𝒮)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  obtain pt "ist" 𝒪t t 𝒟t θt sbt where
    t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
    by (cases t)

  from Cons.prems t obtain
    other': "i p is θ sb 𝒟 𝒪 . i < length ts  ts!i = (p,is,θ,sb,𝒟,𝒪,) 
              a  𝒪  all_acquired sb" and
    a_notin: "a  𝒪t  all_acquired sbt"
  apply -
  apply (rule that)
  apply  clarsimp
         subgoal for i p "is" θ sb 𝒟 𝒪 ℛ
         apply (drule_tac x="Suc i" in spec)
         apply clarsimp
         done
  apply (drule_tac x="0" in spec)
  apply clarsimp
  done 

  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts".
  have consis: "sharing_consis 𝒮 (t#ts)" by fact
  then interpret sharing_consis 𝒮 "t#ts".

  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".
  
  from sharing_consis_tl [OF consis]
  have consis': "sharing_consis 𝒮 ts".
  then
  interpret consis': sharing_consis 𝒮 "ts".
  
  let ?𝒮' = "(share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮)"

  from sharing_consis [of 0, simplified, OF t]
  have "sharing_consistent 𝒮 𝒪t sbt".
  from sharing_consistent_takeWhile [OF this]
  have consis_sb: "sharing_consistent 𝒮 𝒪t (takeWhile (Not  is_volatile_Writesb) sbt)".
  from freshly_shared_owned [OF consis_sb]
  have fresh_owned: "dom ?𝒮' - dom 𝒮  𝒪t".
  from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
  have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
                  all_acquired (takeWhile (Not  is_volatile_Writesb) sbt)  𝒪t"
    by simp

  have sep: 
    "i < length ts. let (_,_,_,sb',_,_,_) = ts!i in 
          all_acquired sb'  dom 𝒮 - dom ?𝒮' = {}  
          all_unshared sb'  dom ?𝒮' - dom 𝒮 = {}"
  proof -
    {
      fix i pi "isi" 𝒪i i 𝒟i θi sbi
      assume i_bound: "i < length ts"
      assume ts_i: "ts ! i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
      have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}  
            all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
      proof -
	from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
	have dist: "(𝒪t  all_acquired sbt)  (𝒪i  all_acquired sbi) = {}"
	  by force


	from dist unshared_acq_owned all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" sbt]
	have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}"
	  by blast

	moreover
	
	from sharing_consis [of "Suc i"] ts_i i_bound
	have "sharing_consistent 𝒮 𝒪i sbi"
	  by force
	from unshared_acquired_or_owned [OF this]
	have "all_unshared sbi  all_acquired sbi  𝒪i".      
	with dist fresh_owned
	have "all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
	  by blast
      
	ultimately show ?thesis by simp
      qed
    }
    thus ?thesis
      by (fastforce simp add: Let_def)
  qed

  from consis'.sharing_consis_preservation [OF this]
  have "sharing_consis ?𝒮' ts".

  from Cons.hyps [OF dist' this other']
  have "share_all_until_volatile_write ts ?𝒮' a =
    share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮 a" .
  moreover
  from share_other_untouched [OF consis_sb] a_notin 
    all_acquired_append [of "(takeWhile (Not  is_volatile_Writesb) sbt)" "(dropWhile (Not  is_volatile_Writesb) sbt)"]
  have "share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮 a = 𝒮 a"
    by auto
  ultimately
  show ?case
    by (simp add: t)
qed

lemma share_shared_eq: "𝒮' 𝒮. 𝒮' a = 𝒮 a  share sb 𝒮' a = share sb 𝒮 a"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  have eq: "𝒮' a = 𝒮 a" by fact
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      
      have "(𝒮'W RA L) a = (𝒮W RA L) a"
      using eq by (auto simp add: augment_shared_def restrict_shared_def)
      from Cons.hyps [of "(𝒮'W RA L)" "(𝒮W RA L)", OF this]
      show ?thesis
        by (clarsimp simp add: Writesb True)
    next
      case False
      with Cons.hyps [of 𝒮' 𝒮] Cons.prems show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case Readsb
    with Cons.hyps [of 𝒮' 𝒮] Cons.prems show ?thesis
      by (auto simp add: Readsb)
  next
    case Progsb
    with Cons.hyps [of 𝒮' 𝒮] Cons.prems show ?thesis
      by (auto simp add: Readsb)
  next
    case (Ghostsb A L R W)
    have "(𝒮'W RA L) a = (𝒮W RA L) a"
    using eq by (auto simp add: augment_shared_def restrict_shared_def)
    from Cons.hyps [of "(𝒮'W RA L)" "(𝒮W RA L)", OF this]
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed

lemma  share_all_until_volatile_write_thread_local:
  assumes dist: "ownership_distinct ts"
  assumes consis: "sharing_consis 𝒮 ts"
  assumes i_bound: "i < length ts"
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
  assumes a_owned: "a  𝒪  all_acquired sb"
  shows "share_all_until_volatile_write ts 𝒮 a = share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮 a"
using dist consis i_bound ts_i
proof (induct ts arbitrary: 𝒮 i)
  case Nil thus ?case by simp
next
  case (Cons t ts)


  obtain pt "ist" 𝒪t t 𝒟t θt sbt where
    t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
    by (cases t)

  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts".
  have consis: "sharing_consis 𝒮 (t#ts)" by fact
  then interpret sharing_consis 𝒮 "t#ts".
  
  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".

  from sharing_consis_tl [OF consis]
  have consis': "sharing_consis 𝒮 ts".
  then
  interpret consis': sharing_consis 𝒮 "ts".
  let ?𝒮' = "(share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮)"

  from sharing_consis [of 0, simplified, OF t]
  have "sharing_consistent 𝒮 𝒪t sbt".
  from sharing_consistent_takeWhile [OF this]
  have consis_sb: "sharing_consistent 𝒮 𝒪t (takeWhile (Not  is_volatile_Writesb) sbt)".
  from freshly_shared_owned [OF consis_sb]
  have fresh_owned: "dom ?𝒮' - dom 𝒮  𝒪t".
  from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
  have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
                  all_acquired (takeWhile (Not  is_volatile_Writesb) sbt)  𝒪t"
    by simp

  have sep: 
    "i < length ts. let (_,_,_,sb',_,_,_) = ts!i in 
          all_acquired sb'  dom 𝒮 - dom ?𝒮' = {}  
          all_unshared sb'  dom ?𝒮' - dom 𝒮 = {}"
  proof -
    {
      fix i pi "isi" 𝒪i i 𝒟i θi sbi
      assume i_bound: "i < length ts"
      assume ts_i: "ts ! i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
      have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}  
            all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
      proof -
	from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
	have dist: "(𝒪t  all_acquired sbt)  (𝒪i  all_acquired sbi) = {}"
	  by force


	from dist unshared_acq_owned all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" sbt]
	have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}"
	  by blast

	moreover
	
	from sharing_consis [of "Suc i"] ts_i i_bound
	have "sharing_consistent 𝒮 𝒪i sbi"
	  by force
	from unshared_acquired_or_owned [OF this]
	have "all_unshared sbi  all_acquired sbi  𝒪i".      
	with dist fresh_owned
	have "all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
	  by blast
      
	ultimately show ?thesis by simp
      qed
    }
    thus ?thesis
      by (fastforce simp add: Let_def)
  qed

  from consis'.sharing_consis_preservation [OF this]
  have consis_shared': "sharing_consis ?𝒮' ts".


  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto

  show ?case
  proof (cases "i")
    case 0
    with Cons.prems
    have t': "t = (p, is, θ, sb, 𝒟, 𝒪, )" 
      by simp
    
    {
      fix j pj "isj" θj sbj 𝒟j 𝒪j j
      assume j_bound: "j < length ts"
      assume ts_j: "ts ! j = (pj, isj, θj, sbj, 𝒟j, 𝒪j, j)"
      have "a  𝒪j  all_acquired sbj"
      proof -
        from ownership_distinct [of "0" "Suc j", simplified, OF j_bound t ts_j] t a_owned t' 0
        show ?thesis
          by auto
      qed
    }
    
    with share_all_until_volatile_write_unowned [OF dist' consis_shared', of a] 
    have "share_all_until_volatile_write ts ?𝒮' a = ?𝒮' a"
      by fastforce
    then show ?thesis
    using t t' 0
      by (auto simp add: Cons t aargh)
  next
    case (Suc n)
    with Cons.prems obtain n_bound: "n < length ts" and ts_n: "ts!n = (p,is,θ,sb,𝒟,𝒪,)"
      by auto
    from Cons.hyps [OF dist' consis_shared' n_bound ts_n]
    have "share_all_until_volatile_write ts ?𝒮' a =
            share (takeWhile (Not  is_volatile_Writesb) sb) ?𝒮' a" .
    moreover 
    from ownership_distinct [of "0" "Suc n"] t a_owned ts_n n_bound
    have "a  𝒪t  all_acquired sbt"
      by fastforce
    with share_other_untouched [OF consis_sb, of a]  
      all_acquired_append [of "(takeWhile (Not  is_volatile_Writesb) sbt)" "(dropWhile (Not  is_volatile_Writesb) sbt)"]
    have "?𝒮' a = 𝒮 a"
      by auto
    from share_shared_eq [of ?𝒮' a 𝒮,OF this ]
    have "share (takeWhile (Not  is_volatile_Writesb) sb) ?𝒮' a = 
           share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮 a" .
    ultimately show ?thesis
    using t Suc 
      by (auto simp add: aargh)
  qed
qed

lemma share_all_until_volatile_write_thread_local':
  assumes dist: "ownership_distinct ts"
  assumes consis: "sharing_consis 𝒮 ts"
  assumes i_bound: "i < length ts"
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
  assumes a_owned: "a  𝒪  all_acquired sb"
  shows "share (dropWhile (Not  is_volatile_Writesb) sb) (share_all_until_volatile_write ts 𝒮) a = 
          share sb 𝒮 a"
proof -
  let ?take = "takeWhile (Not  is_volatile_Writesb) sb"
  let ?drop = "dropWhile (Not  is_volatile_Writesb) sb"
  from share_all_until_volatile_write_thread_local [OF dist consis i_bound ts_i a_owned]
  have "share_all_until_volatile_write ts 𝒮 a = share ?take 𝒮 a" .
  moreover
  from share_shared_eq [of "share_all_until_volatile_write ts 𝒮" a "share ?take 𝒮", OF this]
  have "share ?drop (share_all_until_volatile_write ts 𝒮) a = share ?drop (share ?take 𝒮) a" .
  thus ?thesis
  using share_append [of ?take ?drop 𝒮]
    by simp
qed

lemma (in ownership_distinct) in_shared_sb_share_all_until_volatile_write:
  assumes consis: "sharing_consis 𝒮 ts"
  assumes i_bound: "i < length ts"
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
  assumes a_owned: "a  𝒪  all_acquired sb"
  assumes a_share: "a  dom (share sb 𝒮)"
  shows "a  dom (share (dropWhile (Not  is_volatile_Writesb) sb) 
                    (share_all_until_volatile_write ts 𝒮))"
proof -
  have dist: "ownership_distinct ts" 
  using assms ownership_distinct
    apply -
    apply (rule ownership_distinct.intro)
    apply auto
    done
  from share_all_until_volatile_write_thread_local' [OF dist consis i_bound ts_i a_owned]
    a_share
  show ?thesis
    by (auto simp add: domIff)
qed

lemma owns_unshared_share_acquired:
  "𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb; a  𝒪; a  all_unshared sb
   a  dom (share sb 𝒮)  acquired True sb 𝒪"
proof (induct sb)
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	a_owns: "a  𝒪" and A_shared_onws: "A  dom 𝒮  𝒪" and
	a_L: "a  L" and a_unsh: " a  all_unshared sb" and L_A: "L  A" and
        A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb volatile)
      have "a  dom (share sb (𝒮W RA L))  acquired True sb (𝒪  A - R)"
      proof (cases "a  R")
	case True
	with a_L have "a  dom (𝒮W RA L)"
	  by auto
	from unshared_share_in [OF this a_unsh]
	show ?thesis by blast
      next
	case False
	hence "a  𝒪  A - R"
	  using a_owns
	  by auto
	from Cons.hyps [OF consis' this a_unsh]
	show ?thesis .
      qed
      then
      show ?thesis
	by (clarsimp simp add: Writesb volatile) 
    next
      case False
      with Cons
      show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case Progsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      a_owns: "a  𝒪" and A_shared_onws: "A  dom 𝒮  𝒪" and
      a_L: "a  L" and a_unsh: " a  all_unshared sb" and L_A: "L  A" and
      A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb)
    have "a  dom (share sb (𝒮W RA L))  acquired True sb (𝒪  A - R)"
    proof (cases "a  R")
      case True
      with a_L have "a  dom (𝒮W RA L)"
        by auto
      from unshared_share_in [OF this a_unsh]
      show ?thesis by blast
    next
      case False
      hence "a  𝒪  A - R"
        using a_owns
	by auto
      from Cons.hyps [OF consis' this a_unsh]
      show ?thesis .
    qed
    then show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed

lemma shared_share_acquired: "𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb  
  a  dom 𝒮  a  dom (share sb 𝒮)  acquired True sb 𝒪"    
proof (induct sb)
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	a_shared: "a  dom 𝒮" and A_shared_owns: "A  dom 𝒮  𝒪" and
	L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
        consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True) 
      show ?thesis
      proof (cases "a  L")
	case False with a_shared
	have "a  dom (𝒮W RA L)"
	  by auto
	from Cons.hyps [OF consis' this]
	show ?thesis
	  by (clarsimp simp add: Writesb volatile)
      next
	case True
	with L_A have a_A: "a  A"
	  by blast
	from sharing_consistent_mono_shared [OF _ consis', where 𝒮'="(𝒮W R)"]
	have "sharing_consistent (𝒮W R) (𝒪  A - R) sb"
	  by auto
	from Cons.hyps [OF this] a_shared
	have hyp: "a  dom (share sb (𝒮W R))  acquired True sb (𝒪  A - R)"
	  by auto
	{
	  assume "a  dom (share sb (𝒮W R))"
	  from share_unshared_in [OF this]
	  have "a  dom (share sb (𝒮W RA L))  acquired True sb (𝒪  A - R)"
	  proof 
	    assume "a  dom (share sb Map.empty)"
	    from share_mono_in [OF this]
	    have "a  dom (share sb (𝒮W RA L))"
	      by auto
	    thus ?thesis by blast
	  next
	    assume "a  dom (𝒮W R)  a  all_unshared sb"
	    hence a_unsh: "a  all_unshared sb" by blast
	    from a_A A_R have "a  𝒪  A - R"
	      by auto
	    from owns_unshared_share_acquired [OF consis' this a_unsh]
	    show ?thesis .
	  qed
	}
	with hyp show ?thesis
	  by (auto simp add: Writesb volatile)
      qed
    next
      case False
      with Cons
      show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case Progsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      a_shared: "a  dom 𝒮" and A_shared_owns: "A  dom 𝒮  𝒪" and
      L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb) 
    show ?thesis
    proof (cases "a  L")
      case False with a_shared
      have "a  dom (𝒮W RA L)"
        by auto
      from Cons.hyps [OF consis' this]
      show ?thesis
        by (clarsimp simp add: Ghostsb)
    next
      case True
      with L_A have a_A: "a  A"
        by blast
      from sharing_consistent_mono_shared [OF _ consis', where 𝒮'="(𝒮W R)"]
      have "sharing_consistent (𝒮W R) (𝒪  A - R) sb"
        by auto
      from Cons.hyps [OF this] a_shared
      have hyp: "a  dom (share sb (𝒮W R))  acquired True sb (𝒪  A - R)"
        by auto
      {
	assume "a  dom (share sb (𝒮W R))"
	from share_unshared_in [OF this]
	have "a  dom (share sb (𝒮W RA L))  acquired True sb (𝒪  A - R)"
        proof 
	  assume "a  dom (share sb Map.empty)"
	  from share_mono_in [OF this]
	  have "a  dom (share sb (𝒮W RA L))"
	    by auto
	  thus ?thesis by blast
        next
	  assume "a  dom (𝒮W R)  a  all_unshared sb"
	  hence a_unsh: "a  all_unshared sb" by blast
	  from a_A A_R have "a  𝒪  A - R"
	    by auto
	  from owns_unshared_share_acquired [OF consis' this a_unsh]
	  show ?thesis .
        qed
      }
      with hyp show ?thesis
        by (auto simp add: Ghostsb)
    qed
  qed
qed

lemma dom_release_takeWhile:
  "S .
  dom (release (takeWhile (Not  is_volatile_Writesb) sb) S ) = 
  dom   all_shared (takeWhile (Not  is_volatile_Writesb) sb)"
apply (induct sb)
apply  (clarsimp)
subgoal for a sb S ℛ
apply (case_tac a)
apply (auto simp add: augment_rels_def domIff split: if_split_asm option.splits)
done
done

lemma  share_all_until_volatile_write_share_acquired:
  assumes dist: "ownership_distinct ts"
  assumes consis: "sharing_consis 𝒮 ts"
  assumes a_notin: "a  dom 𝒮"
  assumes a_in: "a  dom (share_all_until_volatile_write ts 𝒮)" 
  shows "i < length ts. 
           let (_,_,_,sb,_,_,_) = ts!i 
           in a  all_shared (takeWhile (Not  is_volatile_Writesb) sb)"
using dist consis a_notin a_in 
proof (induct ts arbitrary: 𝒮 i)
  case Nil thus ?case by simp
next
  case (Cons t ts)

  have a_notin: "a  dom 𝒮" by fact
  obtain pt "ist" 𝒪t t 𝒟t θt sbt where
    t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
    by (cases t)    

  let ?take = "(takeWhile (Not  is_volatile_Writesb) sbt)"
  from t Cons.prems 
  have a_in: "a  dom (share_all_until_volatile_write ts (share ?take 𝒮))"
    by auto

  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts".
  have consis: "sharing_consis 𝒮 (t#ts)" by fact
  then interpret sharing_consis 𝒮 "t#ts".
  
  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".

  from sharing_consis_tl [OF consis]
  have consis': "sharing_consis 𝒮 ts".
  then
  interpret consis': sharing_consis 𝒮 "ts".
  let ?𝒮' = "(share ?take 𝒮)"

  from sharing_consis [of 0, simplified, OF t]
  have "sharing_consistent 𝒮 𝒪t sbt".
  from sharing_consistent_takeWhile [OF this]
  have consis_sb: "sharing_consistent 𝒮 𝒪t ?take".
  from freshly_shared_owned [OF consis_sb]
  have fresh_owned: "dom ?𝒮' - dom 𝒮  𝒪t".
  from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
  have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
                  all_acquired ?take  𝒪t"
    by simp

  have sep: 
    "i < length ts. let (_,_,_,sb',_,_,_) = ts!i in 
          all_acquired sb'  dom 𝒮 - dom ?𝒮' = {}  
          all_unshared sb'  dom ?𝒮' - dom 𝒮 = {}"
  proof -
    {
      fix i pi "isi" 𝒪i i 𝒟i θi sbi
      assume i_bound: "i < length ts"
      assume ts_i: "ts ! i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
      have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}  
            all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
      proof -
	from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
	have dist: "(𝒪t  all_acquired sbt)  (𝒪i  all_acquired sbi) = {}"
	  by force


	from dist unshared_acq_owned all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" sbt]
	have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}"
	  by blast

	moreover
	
	from sharing_consis [of "Suc i"] ts_i i_bound
	have "sharing_consistent 𝒮 𝒪i sbi"
	  by force
	from unshared_acquired_or_owned [OF this]
	have "all_unshared sbi  all_acquired sbi  𝒪i".      
	with dist fresh_owned
	have "all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
	  by blast
      
	ultimately show ?thesis by simp
      qed
    }
    thus ?thesis
      by (fastforce simp add: Let_def)
  qed

  from consis'.sharing_consis_preservation [OF this]
  have consis_shared': "sharing_consis ?𝒮' ts".


  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto

  show ?case
  proof (cases "a  all_shared ?take")
    case True
    thus ?thesis
    apply -
    apply (rule_tac x=0 in exI)
    apply (auto simp add: t aargh)
    done
  next
    case False

    have a_notin': "a  dom ?𝒮'"
    proof 
      assume "a  dom ?𝒮'"
      from share_all_shared_in [OF this] False a_notin
      show False
        by auto
    qed
    from Cons.hyps [OF dist' consis_shared' a_notin' a_in]
    obtain i where "i < length ts" and 
      rel: "let (p,is,θ,sb,𝒟,𝒪,) = ts!i 
            in a  all_shared (takeWhile (Not  is_volatile_Writesb) sb)"
      by (auto simp add: Let_def aargh)
    then show ?thesis
      apply -
      apply (rule_tac x = "Suc i" in exI)
      apply (auto simp add: Let_def aargh)
      done
  qed
qed

lemma all_shared_share_acquired: "𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb  
  a  all_shared sb  a  dom (share sb 𝒮)  acquired True sb 𝒪"    
proof (induct sb)
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	a_shared: "a  R  all_shared sb" and A_shared_owns: "A  dom 𝒮  𝒪" and
	L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
        consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True) 
      show ?thesis
      proof (cases "a  all_shared sb")
        case True
        from Cons.hyps [OF consis' True]
        show ?thesis
          by (clarsimp simp add: Writesb volatile)
      next
        case False
        with a_shared have "a  R"
          by auto
        with L_A A_R R_owns have "a  dom (𝒮W RA L)"
          by auto
        from shared_share_acquired [OF consis' this]
        show ?thesis
          by (clarsimp simp add: Writesb volatile)
     qed
   next
      case False
      with Cons
      show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case Progsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      a_shared: "a  R  all_shared sb" and A_shared_owns: "A  dom 𝒮  𝒪" and
      L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb) 
    show ?thesis
    proof (cases "a  all_shared sb")
      case True
      from Cons.hyps [OF consis' True]
      show ?thesis
        by (clarsimp simp add: Ghostsb)
    next
      case False
      with a_shared have "a  R"
        by auto
      with L_A A_R R_owns have "a  dom (𝒮W RA L)"
        by auto
      from shared_share_acquired [OF consis' this]
      show ?thesis
        by (clarsimp simp add: Ghostsb)
    qed
  qed
qed

lemma (in ownership_distinct) share_all_until_volatile_write_share_acquired:
  assumes consis: "sharing_consis 𝒮 ts"
  assumes i_bound: "i < length ts"
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
  assumes a_in: "a  dom (share_all_until_volatile_write ts 𝒮)" 
  shows "a  dom (share sb 𝒮)  a  acquired True sb 𝒪     
          (j < length ts.  j  i 
           (let (_,_,_,sbj,_,_,_) = ts!j 
            in a  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)))"
proof -
  from assms ownership_distinct have dist: "ownership_distinct ts" 
    apply - 
    apply (rule ownership_distinct.intro)
    apply simp
    done
  from consis
  interpret sharing_consis 𝒮 ts .
  from sharing_consis [OF i_bound ts_i]
  have consis_sb: "sharing_consistent 𝒮 𝒪 sb".

  let ?take_sb = "takeWhile (Not  is_volatile_Writesb) sb"
  let ?drop_sb = "dropWhile (Not  is_volatile_Writesb) sb"

  show ?thesis
  proof (cases "a  dom 𝒮")
    case True
    from shared_share_acquired [OF consis_sb True]
    have "a  dom (share sb 𝒮)  acquired True sb 𝒪".
    thus ?thesis by auto
  next
    case False
    from share_all_until_volatile_write_share_acquired [OF dist consis False a_in]
    obtain j where j_bound: "j < length ts" and 
      rel: "let (_,_,_,sbj,_,_,_) = ts!j 
            in a  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)" 
      by auto
    show ?thesis
    proof (cases "j=i")
      case False
      with j_bound rel 
      show ?thesis
        by blast
    next
      case True
      with rel ts_i have "a  all_shared ?take_sb"
        by (auto simp add: Let_def)
      hence "a  all_shared sb" 
      using all_shared_append [of ?take_sb ?drop_sb]
        by auto
      from all_shared_share_acquired [OF consis_sb this]
      have "a  dom (share sb 𝒮)  acquired True sb 𝒪".
      thus ?thesis
        by auto
    qed
  qed
qed
    
(*
lemma all_unshared_acquired: 
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  assumes a_in: "a ∈ all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)" 
  shows "a ∈ acquired True (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒪" 
proof -
  from unshared_acquired_or_owned [OF sharing_consistent_takeWhile [OF consis]]
  have "all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb) ⊆ 
    𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sb)"
    by auto
  with a_in acquired_takeWhile_non_volatile_Writesb [of sb 𝒪]
  show ?thesis
    apply (auto )
qed
*)

(*
lemma not_acquired_all_unshared: 
  assumes consis: "sharing_consistent 𝒮 𝒪 sb"
  assumes a_notin: "a ∉ acquired True (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒪" 
  shows "a ∉ all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)"
proof -
  from a_notin
  have "a ∉ 𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sb)"
    by (simp add: acquired_takeWhile_non_volatile_Writesb) 
  moreover
  
  from unshared_acquired_or_owned [OF sharing_consistent_takeWhile [OF consis]]
  have "all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb) ⊆ 
    𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sb)"
    by auto
  
  ultimately show ?thesis
    by auto
qed

*)

(*
lemma (in valid_sharing) unacquired_share_all_until_volatile_write:
shows
  "- ⋃ (λ(_,_,_,sb,_,𝒪,_).  acquired True (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒪) ` set ts 
    ⊆ dom (share_all_until_volatile_write ts 𝒮)" (is "- ?U ⊆ ?S")
proof
  fix a
  assume a_U: "a ∈ - ?U"
  show "a ∈ ?S"
  proof -
    from a_U have a_not_U: "a ∉ ?U"
      by auto
    with acquired_takeWhile_non_volatile_Writesb
    have a_notin: "a ∉ ⋃ (λ(_,_,_,sb,_,𝒪).  𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sb)) ` set ts "
      by force
    from a_notin have a_unowned: "a ∉ ⋃ (λ(_,_,_,_,_,𝒪).  𝒪) ` set ts"
      by blast
    from a_unowned unowned_shared
    have a_shared: "a ∈ dom 𝒮"
      by auto

    moreover

    have "a ∉ ⋃ (λ(_,_,_,sb,_,𝒪).  all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)) ` set ts "
          (is "a ∉ ?UNSH")
    proof
      assume "a ∈ ?UNSH"
      from in_Union_image_nth_conv [OF this]
      obtain i p "is" 𝒪 𝒟 θ sb where
	i_bound: "i < length ts" and
	ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪)" and
	a_in: "a ∈ all_unshared (takeWhile (Not ∘ is_volatile_Writesb) sb)"
	by fastforce
      from all_unshared_acquired [OF sharing_consis [OF i_bound ts_i] a_in]
      have "a ∈ acquired True (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒪".
      with a_not_U nth_mem [OF i_bound] ts_i
      show False

	by (auto)
    qed

    ultimately
    show ?thesis
      apply (simp only: share_all_until_volatile_all_unshared)
      apply blast
      done
  qed
qed
*)
lemma acquired_all_shared_in: 
  "A. a  acquired True sb A  a  acquired True sb {}  (a  A  a  all_shared sb)"
proof (induct sb)
    case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A' L R)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems
      have a_in: "a  acquired True sb (A  A' - R)"
	by (clarsimp simp add: Writesb True)
      show ?thesis
      proof (cases "a  A")
	case True
	from Cons.hyps [OF a_in]
	have "a  acquired True sb {}  a  A  A' - R  a  all_shared sb".
	then show ?thesis
	proof 
	  assume "a  acquired True sb {}"
	  from acquired_mono_in [OF this]
	  have "a  acquired True sb (A' - R)" by auto
	  then show ?thesis
	    by (clarsimp simp add: Writesb volatile True)
	next
	  assume "a  A  A' - R  a  all_shared sb"
	  then obtain "a  R" "a  all_shared sb"
	    by blast
	  then show ?thesis by (clarsimp simp add: Writesb volatile True)
	qed
      next
	case False
	have "(A  A' - R)  A  (A' - R)"
	  by blast
	from acquired_mono [OF this] a_in
	have "a  acquired True sb (A  (A' - R))" by blast
	from acquired_union_notin_first [OF this False]
	have "a  acquired True sb (A' - R)".
	then show ?thesis
	  by (clarsimp simp add: Writesb True)
      qed
    next
      case False
      with Cons show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case Readsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case Progsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case (Ghostsb A' L R W)
    from Cons.prems
    have a_in: "a  acquired True sb (A  A' - R)"
      by (clarsimp simp add: Ghostsb)
    show ?thesis
    proof (cases "a  A")
      case True
      from Cons.hyps [OF a_in]
      have "a  acquired True sb {}  a  A  A' - R  a  all_shared sb".
      then show ?thesis
      proof 
	assume "a  acquired True sb {}"
	from acquired_mono_in [OF this]
	have "a  acquired True sb (A' - R)" by auto
        then show ?thesis
	  by (clarsimp simp add: Ghostsb True)
      next
	assume "a  A  A' - R  a  all_shared sb"
	then obtain "a  R" "a  all_shared sb"
	  by blast
	then show ?thesis by (clarsimp simp add: Ghostsb True)
      qed
    next
      case False
      have "(A  A' - R)  A  (A' - R)"
        by blast
      from acquired_mono [OF this] a_in
      have "a  acquired True sb (A  (A' - R))" by blast
      from acquired_union_notin_first [OF this False]
      have "a  acquired True sb (A' - R)".
      then show ?thesis
        by (clarsimp simp add: Ghostsb)
    qed
  qed
qed
   

lemma all_shared_acquired_in: "A. a  A  a  all_shared sb  a  acquired True sb A"
proof (induct sb)
    case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A' L R W)
    show ?thesis
    proof (cases volatile)
      case True
      show ?thesis
      proof -
	from Cons.prems obtain a_A: "a  A" and a_R: "a  R" and  a_sb: "a  all_shared sb" 
	  by (clarsimp simp add: Writesb True)
	from a_A a_R have "a  A  A' - R"
	  by blast
	from Cons.hyps [OF this a_sb]
	show ?thesis  
	  by (clarsimp simp add: Writesb True)
      qed
    next
      case False
      with Cons show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case Readsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case Progsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case Ghostsb
    with Cons show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed

lemma owned_share_acquired: "𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb  
  a  𝒪  a  dom (share sb 𝒮)  acquired True sb 𝒪"    
proof (induct sb)
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	a_owned: "a  𝒪" and A_shared_owns: "A  dom 𝒮  𝒪" and
	L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
        consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True) 
      show ?thesis
      proof (cases "a  R")
	case False with a_owned
	have "a  𝒪  A - R"
	  by auto
	from Cons.hyps [OF consis' this]
	show ?thesis
	  by (clarsimp simp add: Writesb volatile)
      next
	case True
	from True L_A A_R have "a  dom (𝒮W RA L)"
	  by auto
	from shared_share_acquired [OF consis' this]
	show ?thesis 
	  by (clarsimp simp add: Writesb volatile True)
      qed
    next
      case False
      with Cons
      show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case Progsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      a_owned: "a  𝒪" and A_shared_owns: "A  dom 𝒮  𝒪" and
      L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb) 
    show ?thesis
    proof (cases "a  R")
      case False with a_owned
      have "a  𝒪  A - R"
        by auto
      from Cons.hyps [OF consis' this]
      show ?thesis
        by (clarsimp simp add: Ghostsb)
    next
      case True
      from True L_A A_R have "a  dom (𝒮W RA L)"
        by auto
      from shared_share_acquired [OF consis' this]
      show ?thesis 
        by (clarsimp simp add: Ghostsb True)
    qed
  qed
qed

(*
lemma (in valid_sharing) a_unowned_by_others_owned_or_shared:
  assumes dist: "ownership_distinct ts"
  assumes i_bound: "i < length ts"
  assumes ts_i: "ts!i = (p,is,tsmp,sb,𝒟,𝒪)"
  assumes a_unowned_others:
        "∀j<length (map owns_sb ts). i ≠ j ⟶ 
          (let (𝒪j,sbj) = (map owns_sb ts)!j 
           in a ∉ acquired True (takeWhile (Not ∘ is_volatile_Writesb) sbj) 𝒪j)" 

  shows "a ∈ acquired True sb 𝒪 ∨ 
         a ∈ dom (share (dropWhile (Not ∘ is_volatile_Writesb) sb) (share_all_until_volatile_write ts 𝒮))"
proof -
  
  let ?take_sb = "(takeWhile (Not ∘ is_volatile_Writesb) sb)"
  let ?drop_sb = "(dropWhile (Not ∘ is_volatile_Writesb) sb)"

{
    fix j pj isj 𝒪j 𝒟j xsj sbj
    assume a_unowned: "a ∉ acquired True ?take_sb 𝒪"
    assume j_bound: "j < length ts"
    assume jth: "ts!j = (pj,isj,xsj, sbj, 𝒟j, 𝒪j)"
    have "a ∉ acquired True (takeWhile (Not ∘ is_volatile_Writesb) sbj) 𝒪j "
    proof (cases "i=j")
      case True
      from a_unowned ts_i jth True
      show ?thesis
	by auto
    next
      case False
      from a_unowned_others [rule_format, of j] j_bound jth False
      have "a ∉ acquired True (takeWhile (Not ∘ is_volatile_Writesb) sbj) 𝒪j"
	by auto
      then
      show ?thesis
	by auto
    qed
  } note lem = this

  from prems have consis: "sharing_consis 𝒮 ts"
    by (simp add: valid_sharing_def)
  
  from sharing_consistent_share_all_until_volatile_write [OF dist consis i_bound ts_i]
  have consis':
    "sharing_consistent (share_all_until_volatile_write ts 𝒮) (acquired True ?take_sb 𝒪) ?drop_sb"
    by simp

  {
    assume a_notin: "a ∉ acquired True sb 𝒪"
    have ?thesis
    proof (cases "a ∈ acquired True ?take_sb 𝒪")
      case True

      from owned_share_acquired [OF consis' True]
      have "a ∈ dom (share ?drop_sb (share_all_until_volatile_write ts 𝒮)) ∪ 
	        acquired True ?drop_sb (acquired True ?take_sb 𝒪)".
      with acquired_append [of True "?take_sb" "?drop_sb" 𝒪]
      show ?thesis
	by auto
    next
      case False
      assume "a ∉ acquired True (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒪"
      from lem [OF this]
      have "a ∈  - ⋃ (λ(_,_,_,sb,_,𝒪). acquired True (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒪) ` set ts"
	by (fastforce simp add: in_set_conv_nth)

      with unacquired_share_all_until_volatile_write 
      have a_in: "a ∈ dom (share_all_until_volatile_write ts 𝒮)"
	by auto

      from shared_share_acquired [OF consis' a_in] acquired_append [of True "?take_sb" "?drop_sb" 𝒪]
      show ?thesis
	by auto
    qed
  } 
  then
  show ?thesis
    by auto
qed

*)
lemma outstanding_refs_non_volatile_Readsb_all_acquired: 
"m 𝒮 𝒪 pending_write. 
  reads_consistent pending_write 𝒪 m sb;non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb;  
a  outstanding_refs is_non_volatile_Readsb sb
 a   𝒪  a  all_acquired sb 
    a  read_only_reads 𝒪 sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	non_vo: "non_volatile_owned_or_read_only True (𝒮W RA L) 
	            (𝒪  A - R) sb" and
        out_vol: "outstanding_refs is_volatile_Readsb sb = {}" and
	out: "a  outstanding_refs is_non_volatile_Readsb sb"
	by (clarsimp simp add: Writesb True) 
      show ?thesis
      proof (cases "a  𝒪")
	case True
	show ?thesis
	  by (clarsimp simp add: Writesb True volatile)
      next
	case False
	from outstanding_non_volatile_Readsb_acquired_or_read_only_reads [OF non_vo out]
	have a_in: "a  acquired_reads True sb (𝒪  A - R) 
                    a  read_only_reads (𝒪  A - R) sb"
	  by auto
	with acquired_reads_all_acquired [of True sb "(𝒪  A - R)"]
	show ?thesis 
	  by (auto simp add: Writesb volatile)
        qed
     next
      case False
      with Cons show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case Readsb
    with Cons show ?thesis
      apply (clarsimp simp del: o_apply simp add: Readsb 
	acquired_takeWhile_non_volatile_Writesb split: if_split_asm)
      apply auto
      done
  next
    case Progsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case (Ghostsb A L)
    with Cons show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed



lemma outstanding_refs_non_volatile_Readsb_all_acquired_dropWhile: 
assumes consis: "reads_consistent pending_write 𝒪 m sb" 
assumes nvo: "non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb"
assumes out: "a  outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) sb)"
shows "a  𝒪  a  all_acquired sb 
       a  read_only_reads 𝒪 sb"
using outstanding_refs_append [of is_non_volatile_Readsb "takeWhile (Not  is_volatile_Writesb) sb" 
  "dropWhile (Not  is_volatile_Writesb) sb"] 
  outstanding_refs_non_volatile_Readsb_all_acquired [OF consis nvo, of a] out
by (auto)


lemma share_commute: 
  "L R 𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb; 
all_shared sb  L = {}; all_shared sb  A = {}; all_acquired sb  R = {};
all_unshared sb  R = {}; all_shared sb  R = {}  
  (share sb (𝒮W RA L)) =
  (share sb 𝒮)W  RA L"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A' L' R' W')
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	L_prop: "(R'  all_shared sb)  L = {}" and 
	A_prop: "(R'  all_shared sb)  A = {}" and 
	R_acq_prop: "(A'  all_acquired sb)  R = {}" and
	R_prop:"(L'  all_unshared sb)  R = {}" and  
	R_prop_sh: "(R'  all_shared sb)  R = {}" and
	A'_shared_owns: "A'  dom 𝒮  𝒪" and L'_A': " L'  A'" and A'_R': "A'  R' = {}" and 
	R'_owns: "R'  𝒪" and
        consis': "sharing_consistent (𝒮W' R'A' L') (𝒪  A' - R') sb" 
	by (clarsimp simp add: Writesb volatile)


      from L_prop obtain R'_L: "R'  L = {}" and acq_L: "all_shared sb  L = {}"
	by blast
      from A_prop obtain R'_A: "R'  A = {}" and acq_A: "all_shared sb  A = {}"
	by blast
      from R_acq_prop obtain A'_R: "A'  R = {}" and acq_R:"all_acquired sb  R = {}" 
	by blast
      from R_prop obtain L'_R: "L'  R = {}" and unsh_R: "all_unshared sb  R = {}"
	by blast
      from R_prop_sh obtain R'_R: "R'  R = {}" and sh_R: "all_shared sb  R = {}"
	by blast

      from Cons.hyps [OF consis' acq_L acq_A acq_R unsh_R sh_R ]
      have "share sb ((𝒮W' R'A' L')W RA L) = share sb (𝒮W' R'A' L')W RA L".

      moreover

      from R'_L L'_R R'_R R'_A A'_R (*A'_R' L'_A'*)
      have "((𝒮W RA L)W' R'A' L') = ((𝒮W' R'A' L')W RA L)"
	apply -
	apply (rule ext)
	apply (clarsimp simp add: augment_shared_def restrict_shared_def)
	apply (auto split: if_split_asm option.splits)
	done
      
      ultimately
      have "share sb ((𝒮W RA L)W' R'A' L') = share sb (𝒮W' R'A' L')W RA L"
	by simp
      then
      show ?thesis
	by (clarsimp simp add: Writesb volatile)
    next
      case False with Cons show ?thesis
	by (clarsimp simp add: Writesb False)
    qed
  next
    case Readsb with Cons show ?thesis
      by (clarsimp simp add: Readsb)
  next
    case Progsb with Cons show ?thesis
      by (clarsimp simp add: Progsb)
  next
    case (Ghostsb A' L' R' W') 
    from Cons.prems obtain 
      L_prop: "(R'  all_shared sb)  L = {}" and 
      A_prop: "(R'  all_shared sb)  A = {}" and 
      R_acq_prop: "(A'  all_acquired sb)  R = {}" and
      R_prop:"(L'  all_unshared sb)  R = {}" and  
      R_prop_sh: "(R'  all_shared sb)  R = {}" and
      A'_shared_owns: "A'  dom 𝒮  𝒪" and L'_A': " L'  A'" and A'_R': "A'  R' = {}" and 
      R'_owns: "R'  𝒪" and
      consis': "sharing_consistent (𝒮W' R'A' L') (𝒪  A' - R') sb" 
      by (clarsimp simp add: Ghostsb)


    from L_prop obtain R'_L: "R'  L = {}" and acq_L: "all_shared sb  L = {}"
      by blast
    from A_prop obtain R'_A: "R'  A = {}" and acq_A: "all_shared sb  A = {}"
      by blast
    from R_acq_prop obtain A'_R: "A'  R = {}" and acq_R:"all_acquired sb  R = {}" 
      by blast
    from R_prop obtain L'_R: "L'  R = {}" and unsh_R: "all_unshared sb  R = {}"
      by blast
    from R_prop_sh obtain R'_R: "R'  R = {}" and sh_R: "all_shared sb  R = {}"
      by blast

    from Cons.hyps [OF consis' acq_L acq_A acq_R unsh_R sh_R ]
    have "share sb ((𝒮W' R'A' L')W RA L) = share sb (𝒮W' R'A' L')W RA L".

    moreover

    from R'_L L'_R R'_R R'_A A'_R (*A'_R' L'_A'*)
    have "((𝒮W RA L)W' R'A' L') = ((𝒮W' R'A' L')W RA L)"
      apply -
      apply (rule ext)
      apply (clarsimp simp add: augment_shared_def restrict_shared_def)
      apply (auto split: if_split_asm option.splits)
      done
      
    ultimately
    have "share sb ((𝒮W RA L)W' R'A' L') = share sb (𝒮W' R'A' L')W RA L"
      by simp
    then
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed


lemma share_all_until_volatile_write_commute:
" 𝒮 R L. ownership_distinct ts; sharing_consis 𝒮 ts;
        i p is 𝒪  𝒟 θ sb. i < length ts  ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {};
        i p is 𝒪  𝒟 θ sb. i < length ts  ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  A = {};
       i p is 𝒪  𝒟 θ sb.  i < length ts  ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  R = {};
       i p is 𝒪  𝒟 θ sb.  i < length ts  ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  R = {};
       i p is 𝒪  𝒟 θ sb.  i < length ts  ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  R = {} 
 
share_all_until_volatile_write ts 𝒮W RA L = share_all_until_volatile_write ts (𝒮W RA L)"
proof (induct ts)
  case Nil
  thus ?case by simp
next
  case (Cons t ts)
  obtain p "is" 𝒪  𝒟 θ sb where
    t: "t=(p,is,θ,sb,𝒟,𝒪,)"
    by (cases t)
  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts".
  have consis: "sharing_consis 𝒮 (t#ts)" by fact
  then interpret sharing_consis 𝒮 "t#ts".

  have L_prop: "i p is 𝒪  𝒟 θ sb. i < length (t#ts)  (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {}" by fact
  hence L_prop': "i p is 𝒪  𝒟 θ sb. i < length (ts)  (ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {}"
    by force
  have A_prop: "i p is 𝒪  𝒟 θ sb. i < length (t#ts)  (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  A = {}" by fact
  hence A_prop': "i p is 𝒪  𝒟 θ sb. i < length (ts)  (ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  A = {}"
    by force
  have  R_prop_acq: "i p is 𝒪  𝒟 θ sb.  i < length (t#ts)  (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" by fact
  hence R_prop_acq': "i p is 𝒪  𝒟 θ sb.  i < length (ts)  (ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  R = {}"
    by force

  have  R_prop: "i p is 𝒪  𝒟 θ sb.  i < length (t#ts)  (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" by fact
  hence R_prop': "i p is 𝒪  𝒟 θ sb.  i < length (ts)  (ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}"
    by force

  have  R_prop_sh: "i p is 𝒪  𝒟 θ sb.  i < length (t#ts)  (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" by fact
  hence R_prop_sh': "i p is 𝒪  𝒟 θ sb.  i < length (ts)  (ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}"
    by force

  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".

  from sharing_consis_tl [OF consis]
  have consis': "sharing_consis 𝒮 ts".
  then
  interpret consis': sharing_consis 𝒮 "ts".

  from L_prop [rule_format, of 0 p "is" θ sb 𝒟 𝒪 ] t 
  have sh_L: "all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {}" 
    by simp

  from A_prop [rule_format, of 0 p "is" θ sb 𝒟 𝒪 ] t 
  have sh_A: "all_shared (takeWhile (Not  is_volatile_Writesb) sb)  A = {}" 
    by simp

  from R_prop_acq [rule_format, of 0 p "is" θ sb 𝒟 𝒪 ] t 
  have acq_R: "all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" 
    by simp

  from R_prop [rule_format, of 0 p "is" θ sb 𝒟 𝒪  ] t 
  have unsh_R: "all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" 
    by simp


  from R_prop_sh [rule_format, of 0 p "is"  θ sb 𝒟 𝒪] t 
  have sh_R: "all_shared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" 
    by simp

  from sharing_consis [of 0, simplified, OF t]
  have "sharing_consistent 𝒮 𝒪 sb".
  from sharing_consistent_takeWhile [OF this]
  have consis_sb: "sharing_consistent 𝒮 𝒪 (takeWhile (Not  is_volatile_Writesb) sb)".

  from share_commute [OF consis_sb sh_L sh_A acq_R unsh_R sh_R]
  have share_eq: 
    "(share (takeWhile (Not  is_volatile_Writesb) sb) (𝒮W RA L)) =
        (share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮)W RA L".
    
  let ?𝒮' = "(share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮)"

  from freshly_shared_owned [OF consis_sb]
  have fresh_owned: "dom ?𝒮' - dom 𝒮  𝒪".
  from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
  have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
                  all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  𝒪"
    by simp


  have sep: 
    "i < length ts. let (_,_,_,sb',_,_,_) = ts!i in 
          all_acquired sb'  dom 𝒮 - dom ?𝒮' = {}  
          all_unshared sb'  dom ?𝒮' - dom 𝒮 = {}"
  proof -
    {
      fix i pi "isi" 𝒪i i 𝒟i θi sbi
      assume i_bound: "i < length ts"
      assume ts_i: "ts ! i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
      have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}  
            all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
      proof -
	from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
	have dist: "(𝒪  all_acquired sb)  (𝒪i  all_acquired sbi) = {}"
	  by force


	from dist unshared_acq_owned all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" sb]
	have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}"
	  by blast

	moreover
	
	from sharing_consis [of "Suc i"] ts_i i_bound
	have "sharing_consistent 𝒮 𝒪i sbi"
	  by force
	from unshared_acquired_or_owned [OF this]
	have "all_unshared sbi  all_acquired sbi  𝒪i".      
	with dist fresh_owned
	have "all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
	  by blast
      
	ultimately show ?thesis by simp
      qed
    }
    thus ?thesis
      by (fastforce simp add: Let_def)
  qed

  from consis'.sharing_consis_preservation [OF sep]
  have sharing_consis': "sharing_consis (share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮) ts".

  from Cons.hyps [OF dist' sharing_consis' L_prop' A_prop' R_prop_acq' R_prop' R_prop_sh']
  have "share_all_until_volatile_write ts ?𝒮'W RA L =
        share_all_until_volatile_write ts (?𝒮'W RA L)".

  then
  have "share_all_until_volatile_write ts
         ?𝒮'W RA L =
        share_all_until_volatile_write ts
          (share (takeWhile (Not  is_volatile_Writesb) sb) (𝒮W RA L))"
    by (simp add: share_eq)
  then
  show ?case
    by (simp add: t)
qed

lemma share_append_Ghostsb: 
  "𝒮. outstanding_refs is_volatile_Writesb sb = {}  (share (sb @ [Ghostsb A L R W]) 𝒮) = (share sb 𝒮)W RA L"
apply (induct sb)
apply simp
subgoal for a sb 𝒮
apply (case_tac a)
apply auto
done
done

lemma share_append_Ghostsb':
  "𝒮. outstanding_refs is_volatile_Writesb sb  {}  
     (share (takeWhile (Not  is_volatile_Writesb) (sb @ [Ghostsb A L R W])) 𝒮) = 
      (share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮)"
apply (induct sb)
apply  simp
subgoal for a sb 𝒮
apply (case_tac a)
apply force+
done
done

lemma share_all_until_volatile_write_append_Ghostsb: 
assumes no_out_VWritesb: "outstanding_refs is_volatile_Writesb sb = {}"
shows "𝒮 i. ownership_distinct ts; sharing_consis 𝒮 ts;
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,);
   j p is 𝒪  𝒟 θ sb. j < length ts  ij  ts!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {};
   j p is 𝒪  𝒟 θ sb. j < length ts  ij  ts!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  A = {};
       j p is 𝒪  𝒟 θ sb.  j < length ts  ij  ts!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  R = {};
       j p is 𝒪  𝒟 θ sb.  j < length ts  ij  ts!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  R = {};
       j p is 𝒪  𝒟 θ sb.  j < length ts  ij  ts!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}
  
  share_all_until_volatile_write (ts[i := (p', is',θ', sb @ [Ghostsb A L R W], 𝒟', 𝒪')]) 𝒮
                = share_all_until_volatile_write ts 𝒮W RA L"
proof (induct ts)
  case Nil
  thus ?case by simp
next
  case (Cons t ts)
  obtain pt "ist" 𝒪t t 𝒟t acqt θt sbt where
    t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
    by (cases t) 
  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts".
  have consis: "sharing_consis 𝒮 (t#ts)" by fact
  then interpret sharing_consis 𝒮 "t#ts".

  have L_prop: "j p is 𝒪  𝒟 θ sb. j < length (t#ts)  ij  (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {}" by fact

  have A_prop: "j p is 𝒪  𝒟 θ sb. j < length (t#ts)  ij  (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  A = {}" by fact

  have  R_prop_acq: "j p is 𝒪  𝒟 θ sb.  j < length (t#ts)  ij (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" by fact
  have  R_prop: "j p is 𝒪  𝒟 θ sb.  j < length (t#ts)  ij (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" by fact

  have  R_prop_sh: "j p is 𝒪  𝒟 θ sb.  j < length (t#ts)  ij  (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" by fact

  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".

  from sharing_consis_tl [OF consis]
  have consis': "sharing_consis 𝒮 ts".
  then
  interpret consis': sharing_consis 𝒮 "ts".


  from sharing_consis [of 0, simplified, OF t]
  have "sharing_consistent 𝒮 𝒪t sbt" .

  from sharing_consistent_takeWhile [OF this]
  have consis_sb: "sharing_consistent 𝒮 𝒪t (takeWhile (Not  is_volatile_Writesb) sbt)".

  let ?𝒮' = "(share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮)"

  from freshly_shared_owned [OF consis_sb]
  have fresh_owned: "dom ?𝒮' - dom 𝒮  𝒪t".
  from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
  have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
                  all_acquired (takeWhile (Not  is_volatile_Writesb) sbt)  𝒪t"
    by simp


  have sep: 
    "i < length ts. let (_,_,_,sb',_,_,_) = ts!i in 
          all_acquired sb'  dom 𝒮 - dom ?𝒮' = {}  
          all_unshared sb'  dom ?𝒮' - dom 𝒮 = {}"
  proof -
    {
      fix i pi "isi" 𝒪i i 𝒟i acqi θi sbi
      assume i_bound: "i < length ts"
      assume ts_i: "ts ! i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
      have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}  
            all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
      proof -
	from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
	have dist: "(𝒪t  all_acquired sbt)  (𝒪i  all_acquired sbi) = {}"
	  by force


	from dist unshared_acq_owned all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" sbt]
	have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}"
	  by blast

	moreover
	
	from sharing_consis [of "Suc i"] ts_i i_bound
	have "sharing_consistent 𝒮 𝒪i sbi"
	  by force
	from unshared_acquired_or_owned [OF this]
	have "all_unshared sbi  all_acquired sbi  𝒪i".      
	with dist fresh_owned
	have "all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
	  by blast
      
	ultimately show ?thesis by simp
      qed
    }
    thus ?thesis
      by (fastforce simp add: Let_def)
  qed

  from consis'.sharing_consis_preservation [OF sep]
  have sharing_consis': "sharing_consis (share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮) ts".

  show ?case
  proof (cases i)
    case 0
    with t Cons.prems have eqs: "pt=p" "ist=is" "𝒪t=𝒪" "t=" "θt=θ" "sbt=sb" "𝒟t=𝒟" 
      by auto

    from no_out_VWritesb
    have flush_all: "takeWhile (Not  is_volatile_Writesb) sb = sb"
      by (auto simp add: outstanding_refs_conv)


    from no_out_VWritesb
    have flush_all': "takeWhile (Not  is_volatile_Writesb) (sb@[Ghostsb A L R W]) = sb@[Ghostsb A L R W]"
      by (auto simp add: outstanding_refs_conv)

    have share_eq:
      "(share (takeWhile (Not  is_volatile_Writesb) (sb @ [Ghostsb A L R W])) 𝒮) = 
            (share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮)W RA  L"
      apply (simp only: flush_all flush_all')
      apply (rule share_append_Ghostsb [OF no_out_VWritesb])
      done

    from L_prop 0 have L_prop': 
    "i p is 𝒪  𝒟 θ sb.
      i < length ts 
      ts ! i = (p, is,θ, sb, 𝒟, 𝒪,) 
      all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {}"
      apply clarsimp
      subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
      apply (drule_tac x="Suc i1" in spec)
      apply auto
      done
      done
    from A_prop 0 have A_prop': 
    "i p is 𝒪  𝒟 θ sb.
      i < length ts 
      ts ! i = (p, is,θ, sb, 𝒟, 𝒪,) 
      all_shared (takeWhile (Not  is_volatile_Writesb) sb)  A = {}"
      apply clarsimp
      subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
      apply (drule_tac x="Suc i1" in spec)
      apply auto
      done
      done
    from R_prop_acq 0 have R_prop_acq':
        "i p is 𝒪  𝒟 θ sb.  i < length ts  ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" 
      apply clarsimp
      subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
      apply (drule_tac x="Suc i1" in spec)
      apply auto
      done
      done
    from R_prop 0 
    have  R_prop': 
      "i p is 𝒪  𝒟 θ sb.  i < length ts  ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" 
      apply clarsimp
      subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
      apply (drule_tac x="Suc i1" in spec)
      apply auto
      done
      done
    from R_prop_sh 0 have R_prop_sh': 
      "i p is 𝒪  𝒟 θ sb.  i < length ts  ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" 
      apply clarsimp
      subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
      apply (drule_tac x="Suc i1" in spec)
      apply auto
      done
      done


    from share_all_until_volatile_write_commute [OF dist' sharing_consis' L_prop' A_prop' R_prop_acq' R_prop' 
      R_prop_sh']

    have "share_all_until_volatile_write ts (share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮W RA L) =
          share_all_until_volatile_write ts (share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮)W RA  L"
      by (simp add: eqs)
    with share_eq
    show ?thesis
      by (clarsimp simp add: 0 t)
  next
    case (Suc k)
    from L_prop Suc
    have L_prop': "j p is 𝒪  𝒟 θ sb. j < length (ts)  kj  (ts)!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {}" by force

    from A_prop Suc
    have A_prop': "j p is 𝒪  𝒟 θ sb. j < length (ts)  kj  (ts)!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  A = {}" by force
    from R_prop_acq Suc have R_prop_acq':
        "j p is 𝒪  𝒟 θ sb.  j < length ts  kj  ts!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  R = {}"  by force

    from R_prop Suc
    have  R_prop': 
      "j p is 𝒪  𝒟 θ sb.  j < length ts  kj  ts!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" by force

    from R_prop_sh Suc have R_prop_sh': 
      "j p is 𝒪  𝒟 θ sb.  j < length ts  kj  ts!j=(p,is,θ,sb,𝒟,𝒪,)  
                    all_shared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}" by force

    from Cons.prems Suc obtain k_bound: "k < length ts" and ts_k: "ts!k =  (p, is,θ, sb, 𝒟, 𝒪,)"
      by auto

    from Cons.hyps [OF dist' sharing_consis' k_bound ts_k L_prop' A_prop' R_prop_acq' R_prop' R_prop_sh']
    show ?thesis
      by (clarsimp simp add: t Suc)
  qed
qed




(*
I think this is what should work:
share_all_until_volatile_write (ts[i :=(p',is',θ',sb',𝒟',𝒪',ℛ')]) (𝒮 ⊕W R ⊖A L) =
share (takeWhile (Not ∘ is_volatile_Writesb) sb') (share_all_until_volatile_write ts 𝒮 ⊕W R ⊖A L)
*)

lemma share_domain_changes:
  "𝒮 𝒮'. a  all_shared sb  all_unshared sb  share sb 𝒮' a = share sb 𝒮 a "
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain a_in: "a  R  all_shared sb  L  all_unshared sb"
        by (clarsimp simp add: Writesb True)
      show ?thesis
      proof (cases "a  R")
        case True
        from True have "(𝒮'W RA L) a = (𝒮W RA L) a"
          by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
        from  share_shared_eq [where 𝒮'="𝒮'W RA L" and 𝒮="𝒮W RA L",  OF this]
        have "share sb (𝒮'W RA L) a = share sb (𝒮W RA L) a"
          by auto
        then show ?thesis
          by (clarsimp simp add: Writesb volatile)
      next
        case False
        note not_R = this
        show ?thesis
        proof (cases "a  L")
          case True        
          from not_R True have "(𝒮'W RA L) a = (𝒮W RA L) a"
            by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
          from  share_shared_eq [where 𝒮'="𝒮'W RA L" and 𝒮="𝒮W RA L",  OF this]
          have "share sb (𝒮'W RA L) a = share sb (𝒮W RA L) a"
            by auto
          then show ?thesis
            by (clarsimp simp add: Writesb volatile)
        next
          case False
          with not_R a_in have "a  all_shared sb  all_unshared sb"
            by auto
          from Cons.hyps [OF this]
          show ?thesis by (clarsimp simp add: Writesb volatile)
        qed
      qed
    next
      case False with Cons show ?thesis by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis by (auto)
  next 
    case Progsb with Cons show ?thesis by (auto)
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain a_in: "a  R  all_shared sb  L  all_unshared sb"
      by (clarsimp simp add: Ghostsb)
    show ?thesis
    proof (cases "a  R")
      case True
      from True have "(𝒮'W RA L) a = (𝒮W RA L) a"
        by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
      from  share_shared_eq [where 𝒮'="𝒮'W RA L" and 𝒮="𝒮W RA L",  OF this]
      have "share sb (𝒮'W RA L) a = share sb (𝒮W RA L) a"
        by auto
      then show ?thesis
       by (clarsimp simp add: Ghostsb)
    next
      case False
      note not_R = this
      show ?thesis
      proof (cases "a  L")
        case True        
        from not_R True have "(𝒮'W RA L) a = (𝒮W RA L) a"
          by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
        from  share_shared_eq [where 𝒮'="𝒮'W RA L" and 𝒮="𝒮W RA L",  OF this]
        have "share sb (𝒮'W RA L) a = share sb (𝒮W RA L) a"
          by auto
        then show ?thesis
          by (clarsimp simp add: Ghostsb)
      next
        case False
        with not_R a_in have "a  all_shared sb  all_unshared sb"
          by auto
        from Cons.hyps [OF this]
        show ?thesis by (clarsimp simp add: Ghostsb)
      qed
    qed
  qed
qed

lemma share_domain_changesX:
  "𝒮 𝒮' X. a  X. 𝒮' a = 𝒮 a 
   a  all_shared sb  all_unshared sb  X  share sb 𝒮' a = share sb 𝒮 a "
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  then have shared_eq: "a  X. 𝒮' a = 𝒮 a"
    by auto
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain a_in: "a  R  all_shared sb  L  all_unshared sb  X"
        by (clarsimp simp add: Writesb True)
      show ?thesis
      proof (cases "a  R")
        case True
        from True have "(𝒮'W RA L) a = (𝒮W RA L) a"
          by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
        from  share_shared_eq [where 𝒮'="𝒮'W RA L" and 𝒮="𝒮W RA L",  OF this]
        have "share sb (𝒮'W RA L) a = share sb (𝒮W RA L) a"
          by auto
        then show ?thesis
          by (clarsimp simp add: Writesb volatile)
      next
        case False
        note not_R = this
        show ?thesis
        proof (cases "a  L")
          case True        
          from not_R True have "(𝒮'W RA L) a = (𝒮W RA L) a"
            by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
          from  share_shared_eq [where 𝒮'="𝒮'W RA L" and 𝒮="𝒮W RA L",  OF this]
          have "share sb (𝒮'W RA L) a = share sb (𝒮W RA L) a"
            by auto
          then show ?thesis
            by (clarsimp simp add: Writesb volatile)
        next
          case False
          from shared_eq have shared_eq': "a  X. (𝒮'W RA L) a = (𝒮W RA L) a"
            by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
          from False not_R a_in have "a  all_shared sb  all_unshared sb  X"
            by auto
          from Cons.hyps [OF shared_eq' this]
          show ?thesis by (clarsimp simp add: Writesb volatile)
        qed
      qed
    next
      case False with Cons show ?thesis by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis by (auto)
  next 
    case Progsb with Cons show ?thesis by (auto)
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain a_in: "a  R  all_shared sb  L  all_unshared sb  X"
      by (clarsimp simp add: Ghostsb)
    show ?thesis
    proof (cases "a  R")
      case True
      from True have "(𝒮'W RA L) a = (𝒮W RA L) a"
        by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
      from  share_shared_eq [where 𝒮'="𝒮'W RA L" and 𝒮="𝒮W RA L",  OF this]
      have "share sb (𝒮'W RA L) a = share sb (𝒮W RA L) a"
        by auto
      then show ?thesis
       by (clarsimp simp add: Ghostsb)
    next
      case False
      note not_R = this
      show ?thesis
      proof (cases "a  L")
        case True        
        from not_R True have "(𝒮'W RA L) a = (𝒮W RA L) a"
          by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
        from  share_shared_eq [where 𝒮'="𝒮'W RA L" and 𝒮="𝒮W RA L",  OF this]
        have "share sb (𝒮'W RA L) a = share sb (𝒮W RA L) a"
          by auto
        then show ?thesis
          by (clarsimp simp add: Ghostsb)
      next
        case False
        from shared_eq have shared_eq': "a  X. (𝒮'W RA L) a = (𝒮W RA L) a"
          by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
        from False not_R a_in have "a  all_shared sb  all_unshared sb  X"
          by auto
        from Cons.hyps [OF shared_eq' this]
        show ?thesis by (clarsimp simp add: Ghostsb)
      qed
    qed
  qed
qed

lemma share_unchanged: 
  "𝒮. a  all_shared sb  all_unshared sb  all_acquired sb  share sb 𝒮 a = 𝒮 a "
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain a_R: "a  R" and a_L: "a  L"  and a_A: "a  A" 
        and a': "a  all_shared sb  all_unshared sb  all_acquired sb"
        by (clarsimp simp add: Writesb True)
      from Cons.hyps [OF a']
      have "share sb (𝒮W RA L) a = (𝒮W RA L) a" .
      moreover
      from a_R a_L a_A have "(𝒮W RA L) a = 𝒮 a"
        by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
      ultimately
      show ?thesis
       by (clarsimp simp add: Writesb True)
   next
     case False with Cons show ?thesis by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis by (auto)
  next 
    case Progsb with Cons show ?thesis by (auto)
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain a_R: "a  R" and a_L: "a  L"  and a_A: "a  A" 
      and a': "a  all_shared sb  all_unshared sb  all_acquired sb"
      by (clarsimp simp add: Ghostsb)
    from Cons.hyps [OF a']
    have "share sb (𝒮W RA L) a = (𝒮W RA L) a" .
    moreover
    from a_R a_L a_A have "(𝒮W RA L) a = 𝒮 a"
      by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
    ultimately
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed

(* FIXME: duplication with share_commute *)
lemma share_augment_release_commute: 
assumes dist: "(R  L  A)  (all_shared sb  all_unshared sb  all_acquired sb) = {}"
shows "(share sb 𝒮W RA L) = share sb (𝒮W RA L)"
proof -
  from dist have shared_eq: "a  all_acquired sb. (𝒮W RA L) a = 𝒮 a"
    by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)  
  {
    fix a
    assume a_in: "a  all_shared sb  all_unshared sb  all_acquired sb"
    from share_domain_changesX [OF shared_eq this]
    have "share sb (𝒮W RA L) a = share sb 𝒮 a".
    also
    from dist a_in have "... = (share sb 𝒮W RA L) a"
      by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)  
    finally have  "share sb (𝒮W RA L) a = (share sb 𝒮W RA L) a".
  }
  moreover
  {
    fix a
    assume a_notin: "a  all_shared sb  all_unshared sb  all_acquired sb"
    from share_unchanged [OF a_notin]
    have "share sb (𝒮W RA L) a = (𝒮W RA L) a".
    moreover
    from share_unchanged [OF a_notin]
    have "share sb 𝒮 a = 𝒮 a".
    hence "(share sb 𝒮W RA L) a = (𝒮W RA L) a"
      by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
    ultimately have "share sb (𝒮W RA L) a = (share sb 𝒮W RA L) a"
      by simp
  }
  ultimately show ?thesis
    apply -
    apply (rule ext)
    subgoal for x
    apply (case_tac "x  all_shared sb  all_unshared sb  all_acquired sb")
    apply auto
    done
    done
qed

lemma share_append_commute: 
  "ys 𝒮. (all_shared xs  all_unshared xs  all_acquired xs)  
             (all_shared ys  all_unshared ys  all_acquired ys) = {} 
 share xs (share ys 𝒮) = share ys (share xs 𝒮)"
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x xs)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems have 
        dist': "(all_shared xs  all_unshared xs  all_acquired xs)  
                (all_shared ys   all_unshared ys  all_acquired ys) = {} "
        apply (clarsimp  simp add: Writesb True)
        apply blast
        done
      from Cons.prems have
        dist: "(R  L  A)  (all_shared ys  all_unshared ys  all_acquired ys) = {}"
        apply (clarsimp  simp add: Writesb True)
        apply blast
        done
      from share_augment_release_commute [OF dist]
      have "(share ys 𝒮W RA L) = share ys (𝒮W RA L)".
      
      with Cons.hyps [OF dist']
      show ?thesis
        by (clarsimp simp add: Writesb True)
    next
      case False with Cons show ?thesis
        by (clarsimp simp add: Writesb False)
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)
    from Cons.prems have 
      dist': "(all_shared xs  all_unshared xs  all_acquired xs)  
                (all_shared ys   all_unshared ys  all_acquired ys) = {} "
      apply (clarsimp  simp add: Ghostsb)
      apply blast
      done
    from Cons.prems have
      dist: "(R  L  A)  (all_shared ys  all_unshared ys  all_acquired ys) = {}"
      apply (clarsimp  simp add: Ghostsb)
      apply blast
      done
    from share_augment_release_commute [OF dist]
    have "(share ys 𝒮W RA L) = share ys (𝒮W RA L)".
      
    with Cons.hyps [OF dist']
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed

lemma share_append_commute': 
  assumes dist: "(all_shared xs  all_unshared xs  all_acquired xs)  
             (all_shared ys  all_unshared ys  all_acquired ys) = {} "
  shows "share (ys@xs) 𝒮 = share (xs@ys) 𝒮"
proof -
  from share_append_commute [OF dist] share_append [of xs ys] share_append [of ys xs]
  show ?thesis
    by simp
qed

lemma share_all_until_volatile_write_share_commute:
shows " 𝒮 (sb'::'a memref list). ownership_distinct ts; sharing_consis 𝒮 ts; 
        i p is 𝒪  𝒟 θ (sb::'a memref list). i < length ts 
             ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_unshared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_acquired (takeWhile (Not  is_volatile_Writesb) sb))  
                    (all_shared sb'  all_unshared sb'  all_acquired sb') = {} 
 
share_all_until_volatile_write ts (share sb' 𝒮) =
share sb' (share_all_until_volatile_write ts 𝒮)"
proof (induct ts)
  case Nil
  thus ?case by simp
next
  case (Cons t ts)
  obtain pt "ist" 𝒪t t 𝒟t θt sbt where
    t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
    by (cases t)

  let ?take = "(takeWhile (Not  is_volatile_Writesb) sbt)"
  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts" .
  have consis: "sharing_consis 𝒮 (t#ts)" by fact
  then interpret sharing_consis 𝒮 "t#ts" .

  have dist_prop: "i p is 𝒪  𝒟 θ sb. i < length (t#ts) 
             (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_unshared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_acquired (takeWhile (Not  is_volatile_Writesb) sb))  
                    (all_shared sb'  all_unshared sb'  all_acquired sb') = {}" by fact
  from dist_prop [rule_format, of 0] t
  have dist_t: "(all_shared ?take  all_unshared ?take  all_acquired ?take)  
         (all_shared sb'  all_unshared sb'  all_acquired sb') = {}"
    apply clarsimp
    done
  from dist_prop have 
  dist_prop':"i p is 𝒪  𝒟 θ sb. i < length ts 
             ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_unshared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_acquired (takeWhile (Not  is_volatile_Writesb) sb))  
                    (all_shared sb'  all_unshared sb'  all_acquired sb') = {}"
    apply (clarsimp)
    subgoal for i p "is" 𝒪 ℛ 𝒟 θ sb
    apply (drule_tac x="Suc i" in spec)
    apply clarsimp
    done
    done

  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".

  from sharing_consis_tl [OF consis]
  have consis': "sharing_consis 𝒮 ts".
  then
  interpret consis': sharing_consis 𝒮 "ts" .

  from sharing_consis [of 0, simplified, OF t]
  have "sharing_consistent 𝒮 𝒪t sbt" .

  from sharing_consistent_takeWhile [OF this]
  have consis_sb: "sharing_consistent 𝒮 𝒪t ?take".

  let ?𝒮' = "(share ?take 𝒮)"

  from freshly_shared_owned [OF consis_sb]
  have fresh_owned: "dom ?𝒮' - dom 𝒮  𝒪t".
  from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
  have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
                  all_acquired (takeWhile (Not  is_volatile_Writesb) sbt)  𝒪t"
    by simp


  have sep: 
    "i < length ts. let (_,_,_,sb',_,_,_) = ts!i in 
          all_acquired sb'  dom 𝒮 - dom ?𝒮' = {}  
          all_unshared sb'  dom ?𝒮' - dom 𝒮 = {}"
  proof -
    {
      fix i pi "isi" 𝒪i i 𝒟i acqi θi sbi
      assume i_bound: "i < length ts"
      assume ts_i: "ts ! i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
      have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}  
            all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
      proof -
	from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
	have dist: "(𝒪t  all_acquired sbt)  (𝒪i  all_acquired sbi) = {}"
	  by force


	from dist unshared_acq_owned all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" sbt]
	have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}"
	  by blast

	moreover
	
	from sharing_consis [of "Suc i"] ts_i i_bound
	have "sharing_consistent 𝒮 𝒪i sbi"
	  by force
	from unshared_acquired_or_owned [OF this]
	have "all_unshared sbi  all_acquired sbi  𝒪i".      
	with dist fresh_owned
	have "all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
	  by blast
      
	ultimately show ?thesis by simp
      qed
    }
    thus ?thesis
      by (fastforce simp add: Let_def)
  qed

  from consis'.sharing_consis_preservation [OF sep]
  have sharing_consis': "sharing_consis ?𝒮' ts".

  have "share_all_until_volatile_write ts (share ?take (share sb' 𝒮)) =
        share sb' (share_all_until_volatile_write ts (share ?take 𝒮))"
  proof -
    from share_append_commute [OF dist_t]
    have "(share ?take (share sb' 𝒮)) = (share sb' (share ?take 𝒮))" .
    then
    have "share_all_until_volatile_write ts (share ?take (share sb' 𝒮)) =
          share_all_until_volatile_write ts (share sb' (share ?take 𝒮))"
      by (simp)
    also
    from Cons.hyps [OF dist' sharing_consis' dist_prop']
    have "... = share sb' (share_all_until_volatile_write ts (share ?take 𝒮))".
    finally show ?thesis .
  qed
  then show ?case
    by (clarsimp simp add: t)
qed
  
  
(* FIXME: move up*)
lemma all_shared_takeWhile_subset: "all_shared (takeWhile P sb)  all_shared sb"
using all_shared_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
  by auto
lemma all_shared_dropWhile_subset: "all_shared (dropWhile P sb)  all_shared sb"
using all_shared_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
  by auto

lemma all_unshared_takeWhile_subset: "all_unshared (takeWhile P sb)  all_unshared sb"
using all_unshared_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
  by auto
lemma all_unshared_dropWhile_subset: "all_unshared (dropWhile P sb)  all_unshared sb"
using all_unshared_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
  by auto

lemma all_acquired_takeWhile_subset: "all_acquired (takeWhile P sb)  all_acquired sb"
using all_acquired_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
  by auto
lemma all_acquired_dropWhile_subset: "all_acquired (dropWhile P sb)  all_acquired sb"
using all_acquired_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
  by auto

lemma share_all_until_volatile_write_flush_commute:
assumes takeWhile_empty: "(takeWhile (Not  is_volatile_Writesb) sb) = []"
shows " 𝒮 R L W A i. ownership_distinct ts; sharing_consis 𝒮 ts; i < length ts;
        ts!i = (p,is,θ,sb,𝒟,𝒪,); 
        i p is 𝒪  𝒟 θ (sb::'a memref list). i < length ts 
             ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_unshared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_acquired (takeWhile (Not  is_volatile_Writesb) sb))  
                    (all_shared (takeWhile (Not  is_volatile_Writesb) sb')  
                     all_unshared (takeWhile (Not  is_volatile_Writesb) sb')  
                     all_acquired (takeWhile (Not  is_volatile_Writesb) sb')) = {};
        j p is 𝒪  𝒟 θ (sb::'a memref list). j < length ts  ij 
             ts!j=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared sb  all_unshared sb  all_acquired sb)  
                    (R  L  A) = {} 
 
share_all_until_volatile_write (ts[i :=(p',is',θ',sb',𝒟',𝒪',ℛ')]) (𝒮W RA L) =
share (takeWhile (Not  is_volatile_Writesb) sb') (share_all_until_volatile_write ts 𝒮W RA L)"
proof (induct ts)
  case Nil
  thus ?case by simp
next
  case (Cons t ts)
  obtain pt "ist" 𝒪t t 𝒟t θt sbt where
    t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
    by (cases t)

  let ?take = "(takeWhile (Not  is_volatile_Writesb) sbt)"
  let ?take_sb' = "(takeWhile (Not  is_volatile_Writesb) sb')"
  let ?drop = "(dropWhile (Not  is_volatile_Writesb) sbt)"
  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts" .
  have consis: "sharing_consis 𝒮 (t#ts)" by fact
  then interpret sharing_consis 𝒮 "t#ts" .
  have dist_prop: "i p is 𝒪  𝒟 θ sb. i < length (t#ts) 
             (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_unshared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_acquired (takeWhile (Not  is_volatile_Writesb) sb))  
                    (all_shared ?take_sb'  all_unshared ?take_sb'  all_acquired ?take_sb') = {}" by fact
  from dist_prop [rule_format, of 0] t
  have dist_t: "(all_shared ?take  all_unshared ?take  all_acquired ?take)  
         (all_shared ?take_sb'  all_unshared ?take_sb'  all_acquired ?take_sb') = {}"
    apply clarsimp
    done
  from dist_prop have 
  dist_prop':"i p is 𝒪  𝒟 θ sb. i < length ts 
             ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_unshared (takeWhile (Not  is_volatile_Writesb) sb) 
                     all_acquired (takeWhile (Not  is_volatile_Writesb) sb))  
                    (all_shared ?take_sb'  all_unshared ?take_sb'  all_acquired ?take_sb') = {}"
    apply (clarsimp)
    subgoal for i p "is" 𝒪 ℛ 𝒟 θ sb
    apply (drule_tac x="Suc i" in spec)
    apply clarsimp
    done
    done
  have dist_prop_R_L_A: "j p is 𝒪  𝒟 θ sb. j < length (t#ts)  i  j
             (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared sb  all_unshared sb  all_acquired sb)  
                    (R  L  A) = {}" by fact

    
  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".

  from sharing_consis_tl [OF consis]
  have consis': "sharing_consis 𝒮 ts".
  then
  interpret consis': sharing_consis 𝒮 "ts" .

  from sharing_consis [of 0, simplified, OF t]
  have "sharing_consistent 𝒮 𝒪t sbt" .

  from sharing_consistent_takeWhile [OF this]
  have consis_sb: "sharing_consistent 𝒮 𝒪t (takeWhile (Not  is_volatile_Writesb) sbt)".

  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto


  show ?case
  proof (cases i)
    case 0

    with t Cons.prems have eqs: "pt=p" "ist=is" "𝒪t=𝒪" "t=" "θt=θ" "sbt=sb" "𝒟t=𝒟" 
      by auto

    let ?𝒮' = "𝒮W RA L"

    from dist_prop_R_L_A 0 have 
      dist_prop_R_L_A':"i p is 𝒪  𝒟 θ sb. i < length ts 
             ts!i=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared sb  all_unshared sb  all_acquired sb)  
                    (R  L  A) = {}"
      apply (clarsimp)
      subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
      apply (drule_tac x="Suc i1" in spec)
      apply clarsimp
      done 
      done
    then 
    have dist_prop_R_L_A'':"i p is 𝒪  𝒟 θ sb. i < length ts 
         ts!i=(p,is,θ,sb,𝒟,𝒪,)  
      (all_shared (takeWhile (Not  is_volatile_Writesb) sb)  all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  
      all_acquired (takeWhile (Not  is_volatile_Writesb) sb))  
      (R  L  A) = {}"
      apply (clarsimp)
      subgoal for i p "is" 𝒪 ℛ 𝒟 θ sb
      apply (cut_tac sb=sb in all_shared_takeWhile_subset [where P="Not  is_volatile_Writesb"])
      apply (cut_tac sb=sb in all_unshared_takeWhile_subset [where P="Not  is_volatile_Writesb"])
      apply (cut_tac sb=sb in all_acquired_takeWhile_subset [where P="Not  is_volatile_Writesb" ])
      apply fastforce
      done
      done

    have  sep: "i<length ts.
      let (_, _, _, sb, _, _, _) = ts ! i
      in aall_acquired sb. ?𝒮' a = 𝒮 a"
    proof -
      {
        fix i pi "isi" 𝒪i i 𝒟i acqi θi sbi a
        assume i_bound: "i < length ts"
        assume ts_i: "ts ! i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
        assume a_in: "a  all_acquired sbi"
        have "?𝒮' a = 𝒮 a"
        proof -
          from dist_prop_R_L_A' [rule_format, OF i_bound ts_i] a_in
          show ?thesis
            by (auto simp add: augment_shared_def restrict_shared_def split: option.splits) 
        qed
      }
      thus ?thesis by auto
    qed
    from consis'.sharing_consis_shared_exchange [OF sep]
    have sharing_consis': "sharing_consis ?𝒮' ts".
    
    from share_all_until_volatile_write_share_commute [of ts "(𝒮W RA L)" "(takeWhile (Not  is_volatile_Writesb) sb')", OF dist' sharing_consis' dist_prop']

    have "share_all_until_volatile_write ts (share ?take_sb' ?𝒮') =
          share ?take_sb' (share_all_until_volatile_write ts ?𝒮')" .

    moreover 

    from dist_prop_R_L_A''
    have "(share_all_until_volatile_write ts (𝒮W RA L)) =
          (share_all_until_volatile_write ts 𝒮W RA L)"

      apply -
      apply (rule  share_all_until_volatile_write_commute [OF dist' consis', of L A R W,symmetric])
      apply (clarsimp,blast)+
      done
    ultimately
    show ?thesis
      using takeWhile_empty
      by (clarsimp simp add: t 0  aargh eqs)
  next
    case (Suc k)
    from Cons.prems Suc obtain k_bound: "k < length ts" and ts_k: "ts!k =  (p, is,θ, sb, 𝒟, 𝒪,)"
      by auto

    let ?𝒮' = "(share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮)"
    from freshly_shared_owned [OF consis_sb]
    have fresh_owned: "dom ?𝒮' - dom 𝒮  𝒪t".
    from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
    have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
                  all_acquired (takeWhile (Not  is_volatile_Writesb) sbt)  𝒪t"
      by simp



    from freshly_shared_owned [OF consis_sb]
    have fresh_owned: "dom ?𝒮' - dom 𝒮  𝒪t".
    from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
    have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
                  all_acquired (takeWhile (Not  is_volatile_Writesb) sbt)  𝒪t"
      by simp


    have sep: 
      "i < length ts. let (_,_,_,sb',_,_,_) = ts!i in 
          all_acquired sb'  dom 𝒮 - dom ?𝒮' = {}  
          all_unshared sb'  dom ?𝒮' - dom 𝒮 = {}"
    proof -
      {
        fix i pi "isi" 𝒪i i 𝒟i acqi θi sbi
        assume i_bound: "i < length ts"
        assume ts_i: "ts ! i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
        have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}  
              all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
        proof -
	  from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
	  have dist: "(𝒪t  all_acquired sbt)  (𝒪i  all_acquired sbi) = {}"
	    by force


	  from dist unshared_acq_owned all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" sbt]
	  have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}"
	    by blast

	  moreover
	
	  from sharing_consis [of "Suc i"] ts_i i_bound
	  have "sharing_consistent 𝒮 𝒪i sbi"
	    by force
	  from unshared_acquired_or_owned [OF this]
	  have "all_unshared sbi  all_acquired sbi  𝒪i".      
	  with dist fresh_owned
	  have "all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
	    by blast
      
	  ultimately show ?thesis by simp
        qed
      }
      thus ?thesis
        by (fastforce simp add: Let_def)
    qed
    from consis'.sharing_consis_preservation [OF sep]
    have sharing_consis': "sharing_consis ?𝒮' ts".


    from dist_prop_R_L_A [rule_format, of 0] Suc t
    have dist_t_R_L_A: "(all_shared sbt  all_unshared sbt  all_acquired sbt)  
         (R  L  A) = {}"
      apply clarsimp
      done
    from dist_t_R_L_A 
    have "(R  L  A)  (all_shared ?take  all_unshared ?take  all_acquired ?take) = {}"
    using all_shared_append [of ?take ?drop] all_unshared_append [of ?take ?drop] all_acquired_append [of ?take ?drop]
      by auto

    from share_augment_release_commute [OF this]
    have "share ?take 𝒮W RA L = share ?take (𝒮W RA L)" .
    moreover
    
    from dist_prop_R_L_A Suc
    have "j p is 𝒪  𝒟 θ sb. j < length (ts)  k  j
       (ts)!j=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared sb  all_unshared sb  all_acquired sb)  
                    (R  L  A) = {}" 
      apply (clarsimp)
      subgoal for j p "is" 𝒪 ℛ 𝒟 θ sb
      apply (drule_tac x="Suc j" in spec)
      apply clarsimp
      done
      done
    note Cons.hyps [OF dist' sharing_consis' k_bound ts_k dist_prop' this, of W]
    ultimately
    show ?thesis
      by (clarsimp simp add: t Suc )
  qed
qed


lemma share_all_until_volatile_write_Ghostsb_commute:
shows " 𝒮 i. ownership_distinct ts; sharing_consis 𝒮 ts; i < length ts;
        ts!i = (p,is,θ,Ghostsb A L R W#sb,𝒟,𝒪,); 
        j p is 𝒪  𝒟 θ sb. j < length ts  ij  ts!j=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared (takeWhile (Not  is_volatile_Writesb) sb)  all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  all_acquired (takeWhile (Not  is_volatile_Writesb) sb))  
                    (R  L  A) = {} 
 
share_all_until_volatile_write (ts[i :=(p',is',θ',sb,𝒟',𝒪',ℛ')]) (𝒮W RA L) =
share_all_until_volatile_write ts 𝒮"
proof (induct ts)
  case Nil
  thus ?case by simp
next
  case (Cons t ts)
  obtain pt "ist" 𝒪t t 𝒟t θt sbt where
    t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
    by (cases t)
  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts" .
  have consis: "sharing_consis 𝒮 (t#ts)" by fact
  then interpret sharing_consis 𝒮 "t#ts" .
  have dist_prop:  "j p is 𝒪  𝒟 θ sb. j < length (t#ts)  ij  (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared (takeWhile (Not  is_volatile_Writesb) sb)  all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  all_acquired (takeWhile (Not  is_volatile_Writesb) sb))  
                    (R  L  A) = {}" by fact

  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".

  from sharing_consis_tl [OF consis]
  have consis': "sharing_consis 𝒮 ts".
  then
  interpret consis': sharing_consis 𝒮 "ts" .

  from sharing_consis [of 0, simplified, OF t]
  have "sharing_consistent 𝒮 𝒪t sbt" .

  from sharing_consistent_takeWhile [OF this]
  have consis_sb: "sharing_consistent 𝒮 𝒪t (takeWhile (Not  is_volatile_Writesb) sbt)".

  let ?𝒮' = "(share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮)"

  from freshly_shared_owned [OF consis_sb]
  have fresh_owned: "dom ?𝒮' - dom 𝒮  𝒪t".
  from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
  have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
                  all_acquired (takeWhile (Not  is_volatile_Writesb) sbt)  𝒪t"
    by simp


  have sep: 
    "i < length ts. let (_,_,_,sb',_,_,_) = ts!i in 
          all_acquired sb'  dom 𝒮 - dom ?𝒮' = {}  
          all_unshared sb'  dom ?𝒮' - dom 𝒮 = {}"
  proof -
    {
      fix i pi "isi" 𝒪i i 𝒟i θi sbi
      assume i_bound: "i < length ts"
      assume ts_i: "ts ! i = (pi,isi,θi,sbi,𝒟i,𝒪i,i)"
      have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}  
            all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
      proof -
	from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
	have dist: "(𝒪t  all_acquired sbt)  (𝒪i  all_acquired sbi) = {}"
	  by force


	from dist unshared_acq_owned all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" sbt]
	have "all_acquired sbi  dom 𝒮 - dom ?𝒮' = {}"
	  by blast

	moreover
	
	from sharing_consis [of "Suc i"] ts_i i_bound
	have "sharing_consistent 𝒮 𝒪i sbi"
	  by force
	from unshared_acquired_or_owned [OF this]
	have "all_unshared sbi  all_acquired sbi  𝒪i".      
	with dist fresh_owned
	have "all_unshared sbi  dom ?𝒮' - dom 𝒮 = {}"
	  by blast
      
	ultimately show ?thesis by simp
      qed
    }
    thus ?thesis
      by (fastforce simp add: Let_def)
  qed

  from consis'.sharing_consis_preservation [OF sep]
  have sharing_consis': "sharing_consis (share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮) ts".

  show ?case
  proof (cases i)
    case 0

    with t Cons.prems have eqs: "pt=p" "ist=is" "𝒪t=𝒪" "t=" "θt=θ" "sbt=Ghostsb A L R W#sb" "𝒟t=𝒟" 
      by auto

    show ?thesis
      by (clarsimp simp add: 0 t eqs)
  next
    case (Suc k)
    from Cons.prems Suc obtain k_bound: "k < length ts" and ts_k: "ts!k =  (p, is,θ, Ghostsb A L R W#sb, 𝒟, 𝒪,)"
      by auto

    from dist_prop Suc 
    have dist_prop':  "j p is 𝒪  𝒟 θ sb. j < length ts  kj  ts!j=(p,is,θ,sb,𝒟,𝒪,)  
                    (all_shared (takeWhile (Not  is_volatile_Writesb) sb)  all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  all_acquired (takeWhile (Not  is_volatile_Writesb) sb))  
                    (R  L  A) = {}" 
      apply (clarsimp)
      subgoal for j p "is" 𝒪 ℛ 𝒟 θ sb
      apply (drule_tac x="Suc j" in spec)
      apply auto
      done
      done

    from Cons.hyps [OF dist' sharing_consis' k_bound ts_k dist_prop']
    have "share_all_until_volatile_write (ts[k := (p', is', θ', sb, 𝒟', 𝒪', ℛ')])
        (share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮W RA L) =
     share_all_until_volatile_write ts
       (share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮)" .
    
    moreover
    from dist_prop [rule_format, of 0 pt "ist" θt sbt 𝒟t  𝒪t t ] t Suc
    have "(R  L  A)  (all_shared (takeWhile (Not  is_volatile_Writesb) sbt)  all_unshared (takeWhile (Not  is_volatile_Writesb) sbt)  all_acquired (takeWhile (Not  is_volatile_Writesb) sbt)) = {}"
      apply clarsimp
      apply blast
      done
    from share_augment_release_commute [OF this]
    have "share (takeWhile (Not  is_volatile_Writesb) sbt) 𝒮W RA L =
      share (takeWhile (Not  is_volatile_Writesb) sbt) (𝒮W RA L)".
    ultimately
      show ?thesis
      by (clarsimp simp add: Suc t)
  qed
qed

lemma share_all_until_volatile_write_update_sb:
assumes congr: "S. share (takeWhile (Not  is_volatile_Writesb) sb') S = share (takeWhile (Not  is_volatile_Writesb) sb) S"
shows  "𝒮 i. i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,) 
  
  share_all_until_volatile_write ts 𝒮 =
    share_all_until_volatile_write (ts[i := (p', is',θ', sb', 𝒟', 𝒪',ℛ')]) 𝒮"
proof (induct ts)
  case Nil
  thus ?case by simp
next
  case (Cons t ts)
  obtain pt "ist" 𝒪t t 𝒟t θt sbt where
    t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
    by (cases t)

  show ?case
  proof (cases i)
    case 0
    with t Cons.prems have eqs: "pt=p" "ist=is" "𝒪t=𝒪" "t=" "θt=θ" "sbt=sb" "𝒟t=𝒟" 
      by auto

    show ?thesis
      by (clarsimp simp add: 0 t eqs congr)
  next
    case (Suc k)
    from Cons.prems Suc obtain k_bound: "k < length ts" and ts_k: "ts!k =  (p, is,θ, sb, 𝒟, 𝒪, )"
      by auto
    from Cons.hyps [OF k_bound ts_k ]
    show ?thesis
      by (clarsimp simp add: t Suc)
  qed
qed

lemma share_all_until_volatile_write_append_Ghostsb':
assumes out_VWritesb: "outstanding_refs is_volatile_Writesb sb  {}"
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
shows "share_all_until_volatile_write ts 𝒮 =
    share_all_until_volatile_write
     (ts[i := (p', is',θ', sb @ [Ghostsb A L R W], 𝒟', 𝒪',ℛ')]) 𝒮"
proof -
  from out_VWritesb 
  have "S. share (takeWhile (Not  is_volatile_Writesb) (sb @ [Ghostsb A L R W])) S = 
             share (takeWhile (Not  is_volatile_Writesb) sb) S"
    by (simp add: outstanding_vol_write_takeWhile_append)
  from share_all_until_volatile_write_update_sb [OF this i_bound ts_i]
  show ?thesis
    by simp
qed

lemma acquired_append_Progsb:
"S. (acquired pending_write (takeWhile (Not  is_volatile_Writesb) (sb @ [Progsb p1 p2 mis])) S) = 
       (acquired pending_write (takeWhile (Not  is_volatile_Writesb) sb) S) "
  by (induct sb) (auto split: memref.splits)

(* FIXME: move up *)
lemma outstanding_refs_non_empty_dropWhile: 
  "outstanding_refs P xs  {}  outstanding_refs P (dropWhile (Not  P) xs)  {}"
apply (induct xs)
apply simp
apply (simp split: if_split_asm)
done

lemma ex_not: "Ex Not"
  by blast



(*
lemma read_only_share_all_until_volatile_write:
  "⋀𝒮. read_only (share_all_until_volatile_write ts 𝒮) ⊆ read_only 𝒮"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  obtain pt "ist" 𝒪tt 𝒟t θt sbt where
    t: "t=(pt,istt,sbt,𝒟t,𝒪t,ℛt)"
    by (cases t)
  let ?take_sbt ="(takeWhile (Not ∘ is_volatile_Writesb) sbt)"
 
  from read_only_share_takeWhile 
  have "read_only (share ?take_sbt 𝒮) ⊆ read_only 𝒮".
  moreover
  from Cons.hyps 
  have "read_only (share_all_until_volatile_write ts (share ?take_sbt 𝒮)) ⊆ 
    read_only (share ?take_sbt 𝒮)".
  ultimately
  show ?case
    by (simp add: t)
qed
*)

(*       
lemma read_only_takeWhile_share_all_until_volatile_write:
  "⋀i 𝒮. ⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪)⟧
   ⟹ read_only (share_all_until_volatile_write ts 𝒮)
       ⊆ read_only (share (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒮)"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  obtain pt "ist" 𝒪t 𝒟t θt sbt where
    t: "t=(pt,istt,sbt,𝒟t,𝒪t)"
    by (cases t)

  let ?take_sb = "(takeWhile (Not ∘ is_volatile_Writesb) sb)"
  let ?take_sbt ="(takeWhile (Not ∘ is_volatile_Writesb) sbt)"

  note i_bound = `i < length (t#ts)`
  note ts_i = `(t#ts)!i = (p,is,θ,sb,𝒟,𝒪)`
  show ?case
  proof (cases i)
    case 0
    from read_only_share_all_until_volatile_write
    have "read_only (share_all_until_volatile_write ts (share ?take_sb 𝒮))
           ⊆ read_only (share ?take_sb 𝒮)".
    with ts_i
    show ?thesis
      by (simp add: t 0 del: o_apply)
  next
    case (Suc k)
    from i_bound Suc have k_bound: "k < length ts"
      by auto
    from ts_i Suc have ts_k: "ts!k = (p,is,θ,sb,𝒟,𝒪)"
      by auto

    from Cons.hyps [OF k_bound ts_k]
    have "read_only (share_all_until_volatile_write ts (share ?take_sbt 𝒮)) ⊆ 
      read_only (share (takeWhile (Not ∘ is_volatile_Writesb) sb) 
           (share ?take_sbt 𝒮))".
    moreover
    from read_only_share_takeWhile
    have "read_only (share ?take_sbt 𝒮) ⊆ read_only 𝒮".
    from share_read_only_mono [OF this, of ?take_sb]
    have "read_only (share ?take_sb (share ?take_sbt 𝒮)) ⊆ 
      read_only (share ?take_sb 𝒮)".
    ultimately
    show ?thesis
      by (simp add: t del: o_apply)
  qed
qed
*)

(*
lemma read_only_takeWhile_dropWhile_share_all_until_volatile_write:
  assumes i_bound: "i < length ts" 
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪)"
  shows "read_only (share (dropWhile (Not ∘ is_volatile_Writesb) sb) 
           (share_all_until_volatile_write ts 𝒮))
          ⊆ read_only (share sb 𝒮)"
proof -
  let ?take_sb = "(takeWhile (Not ∘ is_volatile_Writesb) sb)"
  let ?drop_sb = "(dropWhile (Not ∘ is_volatile_Writesb) sb)"

  from read_only_takeWhile_share_all_until_volatile_write [OF i_bound ts_i]
  have "read_only (share_all_until_volatile_write ts 𝒮)
        ⊆ read_only (share ?take_sb 𝒮)".
  from share_read_only_mono [OF this]
  have "read_only (share ?drop_sb (share_all_until_volatile_write ts 𝒮)) ⊆ 
        read_only (share ?drop_sb (share ?take_sb 𝒮))".
  with share_append [of ?take_sb ?drop_sb 𝒮]
  show ?thesis
    by simp
qed
*)


(* FIXME: unused ? *)
lemma (in computation) concurrent_step_append:
  assumes step: "(ts,m,𝒮)  (ts',m',𝒮')"
  shows "(xs@ts,m,𝒮)  (xs@ts',m',𝒮')"
using step
proof (cases)
  case (Program i p "is" θ sb 𝒟 𝒪  p' is'   )
  then obtain
    i_bound: "i < length ts" and
    ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)" and
    prog_step:   "θp p (p',is')" and
    ts': "ts'=ts[i:=(p',is@is',θ,record p p' is' sb,𝒟,𝒪,)]" and
    𝒮': "𝒮'=𝒮" and
    m': "m'=m"
    by auto
  
  from i_bound have i_bound': "i + length xs < length (xs@ts)"
    by auto

  from ts_i i_bound have ts_i': "(xs@ts)!(i + length xs) = (p,is,θ,sb,𝒟,𝒪,)"
    by (auto simp add: nth_append)
	
  from concurrent_step.Program [OF i_bound' ts_i' prog_step, of m 𝒮 ] ts' i_bound
  show ?thesis    
    by (auto simp add: ts' list_update_append 𝒮' m')
next
  case (Memop i p "is" θ sb  𝒟 𝒪  is' θ' sb' 𝒟' 𝒪' ℛ' )
  then obtain
    i_bound: "i < length ts" and
    ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)" and
    memop_step: "(is,θ,sb,m,𝒟,𝒪,,𝒮) m (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮')" and
    ts': "ts'=ts[i:=(p,is',θ',sb',𝒟',𝒪',ℛ')]"
    by auto

  from i_bound have i_bound': "i + length xs < length (xs@ts)"
    by auto

  from ts_i i_bound have ts_i': "(xs@ts)!(i + length xs) = (p,is,θ,sb,𝒟,𝒪,)"
    by (auto simp add: nth_append)
  
  from concurrent_step.Memop [OF i_bound' ts_i' memop_step] ts' i_bound
  show ?thesis
    by (auto simp add: ts' list_update_append)
next
  case (StoreBuffer i p "is" θ sb 𝒟 𝒪  sb' 𝒪' ℛ')
  then obtain
    i_bound: "i < length ts" and
    ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)" and
    sb_step: "(m,sb,𝒪,,𝒮) sb (m',sb',𝒪',ℛ',𝒮')" and
    ts': "ts'=ts[i:=(p,is,θ,sb',𝒟,𝒪',ℛ')]"
    by auto
  from i_bound have i_bound': "i + length xs < length (xs@ts)"
    by auto

  from ts_i i_bound have ts_i': "(xs@ts)!(i + length xs) = (p,is,θ,sb,𝒟,𝒪,)"
    by (auto simp add: nth_append)
  
  from concurrent_step.StoreBuffer [OF i_bound' ts_i' sb_step] ts' i_bound
  show ?thesis
    by (auto simp add: ts' list_update_append)
qed

primrec weak_sharing_consistent:: "owns  'a memref list   bool"
where
"weak_sharing_consistent 𝒪 [] = True"
| "weak_sharing_consistent 𝒪 (r#rs) =
   (case r of
     Writesb volatile _ _ _ A L R W  
      (if volatile then L  A  A  R = {}  R  𝒪  
                       weak_sharing_consistent (𝒪  A - R) rs
      else weak_sharing_consistent 𝒪 rs)  
   | Ghostsb A L R W  L  A  A  R = {}  R  𝒪  weak_sharing_consistent (𝒪  A - R) rs
   | _  weak_sharing_consistent 𝒪 rs)"

lemma sharing_consistent_weak_sharing_consistent:
  "𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb  weak_sharing_consistent 𝒪 sb"
apply (induct sb)
apply (auto split: memref.splits)
done

lemma weak_sharing_consistent_append: 
"𝒪. weak_sharing_consistent 𝒪 (xs @ ys) =
  (weak_sharing_consistent 𝒪 xs  weak_sharing_consistent (acquired True xs 𝒪) ys)"
apply (induct xs)
apply (auto split: memref.splits)
done

lemma read_only_share_unowned: "𝒪 𝒮.
  weak_sharing_consistent 𝒪 sb; a  𝒪  all_acquired sb; a  read_only (share sb 𝒮) 
   a  read_only 𝒮"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      with Cons Writesb show ?thesis by auto
    next
      case True
      from Cons.hyps [where 𝒮="(𝒮W RA L)" and 𝒪="(𝒪  A - R)"] Cons.prems
      show ?thesis
	by (auto simp add: Writesb True in_read_only_restrict_conv in_read_only_augment_conv
	split: if_split_asm)
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)       
    with Cons.hyps [where 𝒮="(𝒮W RA L)" and 𝒪="(𝒪  A - R)"] Cons.prems show ?thesis 
      by (auto simp add: in_read_only_restrict_conv in_read_only_augment_conv split: if_split_asm)
  qed
qed


(*
lemma read_only_share_not_acquired_takeWhile: "⋀𝒮. 
  read_only (share (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒮) ⊆ 
  - all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sb)"
apply (induct sb)
apply simp
apply (case_tac a)
apply (auto dest: read_only_share_takeWhile_in simp add: in_read_only_restrict_conv)
done

*)
(*
lemma read_only_share_all_until_volatile_Writesb_not_acquired_takeWhile: 
"⋀𝒮. read_only (share_all_until_volatile_write ts 𝒮 ) ⊆ 
               (- ⋃(λ(_, _, _, sb, _, _).
                   all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sb)) ` set ts)"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  
  obtain pt "ist" 𝒪t 𝒟t θt sbt 
    where t: "t=(pt,istt,sbt,𝒟t,𝒪t)"
    by (cases t)

  let "?take" = "(takeWhile (Not ∘ is_volatile_Writesb) sbt)"

  have aargh: "(Not ∘ is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto


  from read_only_share_all_until_volatile_write
  have "read_only (share_all_until_volatile_write ts (share ?take 𝒮)) ⊆
        read_only (share ?take 𝒮)".
  also
  from read_only_share_not_acquired_takeWhile 
  have "read_only (share ?take 𝒮) ⊆ - all_acquired ?take"
    by blast
  finally have "read_only (share_all_until_volatile_write ts (share ?take 𝒮)) ⊆ - all_acquired ?take".

  moreover

  from Cons.hyps [of "share ?take 𝒮"]
  have hyp: "read_only (share_all_until_volatile_write ts (share ?take 𝒮)) ⊆ 
              (- ⋃(λ(_, _, _, sb, _, _).
                   all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sb)) ` set ts)".

  ultimately
  show ?case
    by (force simp add: t aargh)
qed
*)

(*
lemma read_only_share_all_until_volatile_Writesb_not_acquired_takeWhile_in:
assumes a_in: "a ∈ read_only (share_all_until_volatile_write ts 𝒮 )"
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪)"
shows "a ∉ all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sb)"
proof -
  from nth_mem [OF i_bound] ts_i read_only_share_all_until_volatile_Writesb_not_acquired_takeWhile [of ts 𝒮] a_in
  show ?thesis
    by fastforce
qed
*)

lemma share_read_only_mono_in: 
  assumes a_in: "a  read_only (share sb 𝒮)"
  assumes ss: "read_only 𝒮  read_only 𝒮'"
  shows "a  read_only (share sb 𝒮')"
using share_read_only_mono [OF ss] a_in
by auto


lemma read_only_unacquired_share:
  "S 𝒪. 𝒪  read_only S = {}; weak_sharing_consistent 𝒪 sb; a  read_only S; 
  a  all_acquired sb 
 a  read_only (share sb S)"
proof (induct sb)
    case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems
      obtain a_ro: "a  read_only S" and a_A: "a  A" and a_unacq: "a  all_acquired sb" and 
	owns_ro: "𝒪  read_only S = {}" and 
	L_A: "L  A" and A_R:  "A  R = {}" and R_owns: "R  𝒪" and
	consis': "weak_sharing_consistent (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True)

      from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (SW RA L) = {}"
	by (auto simp add: in_read_only_convs)

      from a_ro a_A owns_ro R_owns L_A have a_ro': "a  read_only (SW RA L)"
	by (auto simp add: in_read_only_convs)
      from Cons.hyps [OF owns_ro' consis' a_ro' a_unacq]
      show ?thesis
	by (clarsimp simp add: Writesb True)
    next
      case False
      with Cons show ?thesis
	by (clarsimp simp add: Writesb False)
    qed
  next
    case Readsb with Cons show ?thesis by (clarsimp)
  next
    case Progsb with Cons show ?thesis by (clarsimp)
  next
    case (Ghostsb A L R W)
    from Cons.prems
    obtain a_ro: "a  read_only S" and a_A: "a  A" and a_unacq: "a  all_acquired sb" and 
      owns_ro: "𝒪  read_only S = {}" and 
      L_A: "L  A" and A_R:  "A  R = {}" and R_owns: "R  𝒪" and
      consis': "weak_sharing_consistent (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb)

    from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (SW RA L) = {}"
      by (auto simp add: in_read_only_convs)

    from a_ro a_A owns_ro R_owns L_A have a_ro': "a  read_only (SW RA L)"
      by (auto simp add: in_read_only_convs)
    from Cons.hyps [OF owns_ro' consis' a_ro' a_unacq]
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed



lemma read_only_share_unacquired: " 𝒪 S. 𝒪  read_only S = {}  weak_sharing_consistent 𝒪 sb  
 a  read_only (share sb S)  a  acquired True sb 𝒪"
proof (induct sb)
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      with Cons Writesb show ?thesis by auto
    next
      case True 
      note volatile=this
      from Cons.prems
      obtain a_ro: "a  read_only (share sb (SW RA L))" and
	owns_ro: "𝒪  read_only S = {}" and 
	L_A: "L  A" and A_R:  "A  R = {}" and R_owns: "R  𝒪" and
	consis': "weak_sharing_consistent (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb volatile)

      from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (SW RA L) = {}"
        by (auto simp add: in_read_only_convs)
      from Cons.hyps [OF owns_ro' consis' a_ro]
      show ?thesis
        by (auto simp add: Writesb volatile) 
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)
    from Cons.prems
    obtain a_ro: "a  read_only (share sb (SW RA L))" and
      owns_ro: "𝒪  read_only S = {}" and 
      L_A: "L  A" and A_R:  "A  R = {}" and R_owns: "R  𝒪" and
      consis': "weak_sharing_consistent (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb)

    from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (SW RA L) = {}"
      by (auto simp add: in_read_only_convs)
    from Cons.hyps [OF owns_ro' consis' a_ro]
    show ?thesis
      by (auto simp add: Ghostsb) 
  qed
qed


lemma read_only_share_all_acquired_in: 
  "S 𝒪. 𝒪  read_only S = {}; weak_sharing_consistent 𝒪 sb; a  read_only (share sb S) 
   a  read_only (share sb Map.empty)  (a  read_only S  a  all_acquired sb)"
proof (induct sb)
    case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems
      obtain a_in: "a  read_only (share sb (SW RA L))" and
	owns_ro: "𝒪  read_only S = {}" and 
	L_A: "L  A" and A_R:  "A  R = {}" and R_owns: "R  𝒪" and
	consis': "weak_sharing_consistent (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True)

      from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (SW RA L) = {}"
	by (auto simp add: in_read_only_convs)

      from Cons.hyps [OF owns_ro' consis' a_in]
      have hyp: "a  read_only (share sb Map.empty)  a  read_only (SW RA L)  a  all_acquired sb".

      have "a  read_only (share sb (Map.empty ⊕W RA L))  (a  read_only S  a  A  a  all_acquired sb)"
      proof -
	{
	  assume a_emp: "a  read_only (share sb Map.empty)"
	  have "read_only Map.empty  read_only (Map.empty ⊕W RA L)"
	    by (auto simp add: in_read_only_convs)
	  
	  from share_read_only_mono_in [OF a_emp this]
	  have "a  read_only (share sb (Map.empty ⊕W RA L))".
	}
	moreover
	{
	  assume a_ro: "a  read_only (SW RA L)" and a_unacq: "a  all_acquired sb"
	  have ?thesis
	  proof (cases "a  read_only S")
	    case True
	    with a_ro obtain "a  A"
	      by (auto simp add: in_read_only_convs)
	    with True a_unacq show ?thesis
	      by auto
	  next
	    case False
	    with a_ro have a_ro_empty: "a  read_only (Map.empty ⊕W RA L)"
	      by (auto simp add: in_read_only_convs split: if_split_asm)
	    
	    have "read_only (Map.empty ⊕W RA L)  read_only (SW RA L)"
	      by (auto simp add: in_read_only_convs)
	    with owns_ro'
	    have owns_ro_empty: "(𝒪  A - R)  read_only (Map.empty ⊕W RA L) = {}"
	      by blast


	    from read_only_unacquired_share [OF owns_ro_empty consis' a_ro_empty a_unacq]
	    have "a  read_only (share sb (Map.empty ⊕W RA L))".
	    thus ?thesis
	      by simp
	  qed
	}
	moreover note hyp
	ultimately show ?thesis by blast
      qed

      then show ?thesis
	by (clarsimp simp add: Writesb True)
    next
      case False with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)
    from Cons.prems
    obtain a_in: "a  read_only (share sb (SW RA L))" and
      owns_ro: "𝒪  read_only S = {}" and 
      L_A: "L  A" and A_R:  "A  R = {}" and R_owns: "R  𝒪" and
      consis': "weak_sharing_consistent (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb)
    
    from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (SW RA L) = {}"
      by (auto simp add: in_read_only_convs)

    from Cons.hyps [OF owns_ro' consis' a_in]
    have hyp: "a  read_only (share sb Map.empty)  a  read_only (SW RA L)  a  all_acquired sb".

    have "a  read_only (share sb (Map.empty ⊕W RA L))  (a  read_only S  a  A  a  all_acquired sb)"
    proof -
      {
	assume a_emp: "a  read_only (share sb Map.empty)"
	have "read_only Map.empty  read_only (Map.empty ⊕W RA L)"
	  by (auto simp add: in_read_only_convs)
	  
	from share_read_only_mono_in [OF a_emp this]
	have "a  read_only (share sb (Map.empty ⊕W RA L))".
      }
      moreover
      {
	assume a_ro: "a  read_only (SW RA L)" and a_unacq: "a  all_acquired sb"
	have ?thesis
        proof (cases "a  read_only S")
	  case True
	  with a_ro obtain "a  A"
	    by (auto simp add: in_read_only_convs)
	  with True a_unacq show ?thesis
	    by auto
	next
	  case False
	  with a_ro have a_ro_empty: "a  read_only (Map.empty ⊕W RA L)"
	    by (auto simp add: in_read_only_convs split: if_split_asm)
	    
	  have "read_only (Map.empty ⊕W RA L)  read_only (SW RA L)"
	    by (auto simp add: in_read_only_convs)
	  with owns_ro'
	  have owns_ro_empty: "(𝒪  A - R)  read_only (Map.empty ⊕W RA L) = {}"
	    by blast


	  from read_only_unacquired_share [OF owns_ro_empty consis' a_ro_empty a_unacq]
	  have "a  read_only (share sb (Map.empty ⊕W RA L))".
	  thus ?thesis
	    by simp
	qed
      }
      moreover note hyp
      ultimately show ?thesis by blast
    qed 
    then show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed




lemma weak_sharing_consistent_preserves_distinct:
  "𝒪 𝒮. weak_sharing_consistent 𝒪 sb  𝒪  read_only 𝒮 = {} 
           acquired True sb 𝒪  read_only (share sb 𝒮) = {}"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain
	owns_ro: "𝒪  read_only 𝒮 = {}" and L_A: " L  A" and A_R: "A  R = {}" and
	R_owns: "R  𝒪" and consis': "weak_sharing_consistent (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True)

      from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (𝒮W RA L) = {}"
	by (auto simp add: in_read_only_convs)
      from Cons.hyps [OF consis' owns_ro']
      show ?thesis
	by (auto simp add: Writesb True)
    next
      case False with Cons Writesb show ?thesis by auto
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain
      owns_ro: "𝒪  read_only 𝒮 = {}" and L_A: " L  A" and A_R: "A  R = {}" and
      R_owns: "R  𝒪" and consis': "weak_sharing_consistent (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb)

    from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (𝒮W RA L) = {}"
      by (auto simp add: in_read_only_convs)
    from Cons.hyps [OF consis' owns_ro']
    show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed


locale weak_sharing_consis =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes weak_sharing_consis:
  "i p is 𝒪  𝒟 θ sb. 
   i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)  
   
   weak_sharing_consistent 𝒪 sb"

sublocale sharing_consis  weak_sharing_consis
proof
  fix i p "is" 𝒪  𝒟 θ sb
  assume i_bound: "i < length ts" 
  assume ts_i: "ts ! i = (p, is, θ, sb, 𝒟, 𝒪,)"
  from sharing_consistent_weak_sharing_consistent [OF sharing_consis [OF i_bound ts_i]]
  show "weak_sharing_consistent 𝒪 sb".
qed

    
lemma weak_sharing_consis_tl: "weak_sharing_consis (t#ts)  weak_sharing_consis ts"
apply (unfold weak_sharing_consis_def)
apply force
done


lemma read_only_share_all_until_volatile_write_unacquired:
  "𝒮. ownership_distinct ts; read_only_unowned 𝒮 ts; weak_sharing_consis ts; 
  i < length ts. (let (_,_,_,sb,_,𝒪,) = ts!i in 
     a  all_acquired (takeWhile (Not  is_volatile_Writesb) sb)); 
  a  read_only 𝒮 
   a  read_only (share_all_until_volatile_write ts 𝒮)"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  obtain p "is" 𝒪  𝒟 θ sb where
    t: "t = (p,is,θ,sb,𝒟,𝒪,)"
    by (cases t)

  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts" .
  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".


  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto

  have a_ro: "a  read_only 𝒮" by fact
  have ro_unowned: "read_only_unowned 𝒮 (t#ts)" by fact
  then interpret read_only_unowned 𝒮 "t#ts" .
  have consis: "weak_sharing_consis (t#ts)" by fact
  then interpret weak_sharing_consis "t#ts" .

  note consis' = weak_sharing_consis_tl [OF consis]

  let ?take_sb = "(takeWhile (Not  is_volatile_Writesb) sb)"
  let ?drop_sb = "(dropWhile (Not  is_volatile_Writesb) sb)"

  from weak_sharing_consis [of 0] t
  have consis_sb: "weak_sharing_consistent 𝒪 sb"
    by force
  with weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
  have consis_take: "weak_sharing_consistent 𝒪 ?take_sb"
    by auto


  have ro_unowned': "read_only_unowned (share ?take_sb 𝒮) ts"
  proof 
    fix j
    fix pj isj 𝒪j j 𝒟j θj sbj
    assume j_bound: "j < length ts"
    assume jth: "ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
    show "𝒪j  read_only (share ?take_sb 𝒮) = {}"
    proof -
      {
        fix a
        assume a_owns: "a  𝒪j" 
        assume a_ro: "a  read_only (share ?take_sb 𝒮)"
        have False
        proof -
          from ownership_distinct [of 0 "Suc j"] j_bound jth t
          have dist: "(𝒪  all_acquired sb)  (𝒪j  all_acquired sbj) = {}"
            by fastforce
    
          from read_only_unowned [of "Suc j"] j_bound jth
          have dist_ro: "𝒪j  read_only 𝒮 = {}" by force
          show ?thesis
          proof (cases "a  (𝒪  all_acquired sb)")
            case True
            with dist a_owns show False by auto
          next
            case False
            hence "a   (𝒪  all_acquired ?take_sb)"
            using all_acquired_append [of ?take_sb ?drop_sb]
              by auto
            from read_only_share_unowned [OF consis_take this a_ro]
            have "a  read_only 𝒮".
            with dist_ro a_owns show False by auto
         qed
       qed
      }
      thus ?thesis by auto
    qed
  qed

      
  from Cons.prems
  obtain unacq_ts: "i < length ts. (let (_,_,_,sb,_,𝒪,_) = ts!i in 
           a  all_acquired (takeWhile (Not  is_volatile_Writesb) sb))" and
    unacq_sb: "a  all_acquired (takeWhile (Not  is_volatile_Writesb) sb)" 
    by (force simp add: t aargh)


  
  from read_only_unowned [of 0] t
  have owns_ro: "𝒪  read_only 𝒮 = {}"
    by force
  from read_only_unacquired_share [OF owns_ro consis_take a_ro unacq_sb]
  have "a  read_only (share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮)".
  from Cons.hyps [OF dist' ro_unowned' consis' unacq_ts this]
  show ?case
    by (simp add: t)
qed

lemma read_only_share_unowned_in: 
"weak_sharing_consistent 𝒪 sb; a  read_only (share sb 𝒮)
 a  read_only 𝒮  𝒪  all_acquired sb" 
using read_only_share_unowned [of 𝒪 sb]
by auto


lemma read_only_shared_all_until_volatile_write_subset:
"𝒮. ownership_distinct ts;  
           weak_sharing_consis ts 
read_only (share_all_until_volatile_write ts 𝒮)  
  read_only 𝒮  (((λ(_, _, _, sb, _, 𝒪,_). 𝒪  all_acquired (takeWhile (Not  is_volatile_Writesb) sb)) ` set ts))"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  obtain p "is" 𝒪  𝒟 θ sb where
    t: "t = (p,is,θ,sb,𝒟,𝒪,)"
    by (cases t)

  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts" .
  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".


  have consis: "weak_sharing_consis (t#ts)" by fact
  then interpret weak_sharing_consis "t#ts" .

  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto

  note consis' = weak_sharing_consis_tl [OF consis]

  let ?take_sb = "(takeWhile (Not  is_volatile_Writesb) sb)"
  let ?drop_sb = "(dropWhile (Not  is_volatile_Writesb) sb)"

  from weak_sharing_consis [of 0] t
  have consis_sb: "weak_sharing_consistent 𝒪 sb"
    by force
  with weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
  have consis_take: "weak_sharing_consistent 𝒪 ?take_sb"
    by auto

  {
    fix a
    assume a_in: "a  read_only
              (share_all_until_volatile_write ts
                 (share ?take_sb 𝒮))" and
    a_notin_shared: "a  read_only 𝒮" and
    a_notin_rest: "a  (((λ(_, _, _, sb, _, 𝒪,_). 𝒪  all_acquired (takeWhile (Not  is_volatile_Writesb) sb)) ` set ts))"
    have "a  𝒪  all_acquired (takeWhile (Not  is_volatile_Writesb) sb)"
    proof -
      from Cons.hyps [OF dist' consis', of "(share ?take_sb 𝒮)"] a_in a_notin_rest
      have "a  read_only (share ?take_sb 𝒮)"
        by (auto simp add: aargh)
      from read_only_share_unowned_in [OF consis_take this] a_notin_shared
      show ?thesis by auto
    qed
  }
      
  then show ?case
    by (auto simp add: t aargh)
qed
(*
lemma weak_sharing_consistent_preserves_distinct_share_all_until_volatile_write:
  assumes dist: "ownership_distinct ts" 
  assumes ro: "read_only_unowned 𝒮 ts"  
  assumes consis: "weak_sharing_consis ts" 
  assumes i_bound: "i < length ts" 
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
  shows "acquired True (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒪 ∩ 
     read_only (share_all_until_volatile_write ts 𝒮) = {}"
proof -
  {
    fix a
    assume a_in: "a ∈ acquired True (takeWhile (Not ∘ is_volatile_Writesb) sb) 𝒪"
    assume a_in_share: "a ∈  read_only (share_all_until_volatile_write ts 𝒮)"
    have False
    proof -
      from read_only_shared_all_until_volatile_write_subset [OF dist consis, of 𝒮] a_in_share
      have "a ∈ read_only 𝒮 ∪ 
                  (⋃(λ(_, _, _, sb, _, 𝒪,_). 𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sb)) ` set ts)"
        by fastforce
      moreover
      from acquired_all_acquired [of True "(takeWhile (Not ∘ is_volatile_Writesb) sb)" 𝒪] a_in
      have "a ∈ 𝒪 ∪ 
      find_theorems acquired all_acquired
      from a_in 
*)
lemma weak_sharing_consistent_preserves_distinct_share_all_until_volatile_write:
  "𝒮 i. ownership_distinct ts; read_only_unowned 𝒮 ts;weak_sharing_consis ts; 
 i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,)
  acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪  
  read_only (share_all_until_volatile_write ts 𝒮) = {}"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  note ‹read_only_unowned 𝒮 (t#ts)
  then interpret read_only_unowned 𝒮 "t#ts" .
  note i_bound = i < length (t # ts)
  note ith = (t # ts) ! i = (p,is,θ, sb, 𝒟, 𝒪,)

  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts" .
  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".


  have consis: "weak_sharing_consis (t#ts)" by fact
  then interpret weak_sharing_consis "t#ts" .

  note consis' = weak_sharing_consis_tl [OF consis]

  let ?take_sb = "(takeWhile (Not  is_volatile_Writesb) sb)"
  let ?drop_sb = "(dropWhile (Not  is_volatile_Writesb) sb)"


  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto
  show ?case
  proof (cases i)
    case 0
    from read_only_unowned [of 0] ith 0
    have owns_ro: "𝒪  read_only 𝒮 = {}"
      by force
    from weak_sharing_consis [of 0] ith 0
    have "weak_sharing_consistent 𝒪 sb"
      by force
    with weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
    have consis_take: "weak_sharing_consistent 𝒪 ?take_sb"
      by auto
    from weak_sharing_consistent_preserves_distinct [OF this owns_ro]
    have dist_t: "acquired True ?take_sb 𝒪  read_only (share ?take_sb 𝒮) = {}".
    from read_only_shared_all_until_volatile_write_subset [OF dist' consis', of "(share ?take_sb 𝒮)"]
    have ro_rest: "read_only (share_all_until_volatile_write ts (share ?take_sb 𝒮))  
            read_only (share ?take_sb 𝒮)  
            (((λ(_, _, _, sb, _, 𝒪,_). 𝒪  all_acquired (takeWhile (Not  is_volatile_Writesb) sb)) ` set ts))"
      by auto
    {
      fix a
      assume a_in_sb: "a  acquired True ?take_sb 𝒪"
      assume a_in_ro: "a  read_only (share_all_until_volatile_write ts (share ?take_sb 𝒮))"
      have False
      proof -
        
        from Set.in_mono [rule_format, OF ro_rest a_in_ro] dist_t a_in_sb
        
        have "a  (((λ(_, _, _, sb, _, 𝒪,_). 𝒪  all_acquired (takeWhile (Not  is_volatile_Writesb) sb)) ` set ts))"
          by auto
        then obtain j pj "isj" θj sbj 𝒟j 𝒪j j
            where j_bound: "j < length ts" and ts_j: "ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
            and a_in_j: "a  𝒪j  all_acquired (takeWhile (Not  is_volatile_Writesb) sbj)"
          by (fastforce simp add: in_set_conv_nth)
        from ownership_distinct [of 0 "Suc j"] ith ts_j j_bound 0
        have dist: "(𝒪  all_acquired sb)  (𝒪j  all_acquired sbj) = {}"
          by fastforce
        moreover
        from acquired_all_acquired [of True ?take_sb 𝒪] a_in_sb all_acquired_append [of ?take_sb ?drop_sb]
        have "a  𝒪  all_acquired sb"
          by auto
        with a_in_j all_acquired_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" "(dropWhile (Not  is_volatile_Writesb) sbj)"] 
          dist
        have False by fastforce
        thus ?thesis ..
     qed
   }
   then show ?thesis
   using 0 ith
     by (auto simp add: aargh)
  next
    case (Suc k)
    from i_bound Suc have k_bound: "k < length ts"
      by auto
    from ith Suc have kth: "ts!k = (p, is, θ, sb, 𝒟, 𝒪, )"
      by auto

    obtain pt "ist" 𝒪t t 𝒟t θt sbt 
      where t: "t=(pt,ist,θt,sbt,𝒟t,𝒪t,t)"
      by (cases t)

    let ?take_sbt = "(takeWhile (Not  is_volatile_Writesb) sbt)"
    let ?drop_sbt = "(dropWhile (Not  is_volatile_Writesb) sbt)"

    have ro_unowned': "read_only_unowned (share ?take_sbt 𝒮) ts"
    proof 
      fix j
      fix pj isj 𝒪j j 𝒟j θj sbj
      assume j_bound: "j < length ts"
      assume jth: "ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
      show "𝒪j  read_only (share ?take_sbt 𝒮) = {}"
      proof -
	from read_only_unowned [of "Suc j"] j_bound jth
	have dist: "𝒪j  read_only 𝒮 = {}" by force
        
        from weak_sharing_consis [of 0] t
        have "weak_sharing_consistent 𝒪t sbt" 
          by fastforce
        with weak_sharing_consistent_append [of 𝒪t ?take_sbt ?drop_sbt]
        have consis_t: "weak_sharing_consistent 𝒪t ?take_sbt" 
          by auto
        {
          fix a
          assume a_in_j: "a  𝒪j"
          assume a_ro: "a  read_only (share ?take_sbt 𝒮)"
          have False
          proof -
            from a_in_j ownership_distinct [of 0 "Suc j"] j_bound t jth
            have "(𝒪t  all_acquired sbt)  (𝒪j  all_acquired sbj) = {}"
              by fastforce
            with a_in_j all_acquired_append [of ?take_sbt ?drop_sbt]
            have "a  (𝒪t  all_acquired ?take_sbt)"
              by fastforce
            from  read_only_share_unowned [OF consis_t this a_ro]
            have "a  read_only 𝒮" .
            with a_in_j dist 
            show False by auto
          qed
        }
        then
	show ?thesis
	  by auto
      qed
    qed

    from Cons.hyps [OF dist' ro_unowned' consis' k_bound kth]
    show ?thesis
      by (simp add: t)
  qed
qed


lemma in_read_only_share_all_until_volatile_write:
  assumes dist: "ownership_distinct ts"
  assumes consis: "sharing_consis 𝒮 ts"
  assumes ro_unowned: "read_only_unowned 𝒮 ts"
  assumes i_bound: "i < length ts"
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
  assumes a_unacquired_others: "j < length ts. ij  
            (let (_,_,_,sbj,_,_,_) = ts!j in
            a  all_acquired (takeWhile (Not  is_volatile_Writesb) sbj))"
  assumes a_ro_share: "a  read_only (share sb 𝒮)"
  shows "a  read_only (share (dropWhile (Not  is_volatile_Writesb) sb) 
                    (share_all_until_volatile_write ts 𝒮))"
proof -
  from consis
  interpret sharing_consis 𝒮 ts .
  interpret read_only_unowned 𝒮 ts by fact

  from sharing_consis [OF i_bound ts_i]
  have consis_sb: "sharing_consistent 𝒮 𝒪 sb".
  from sharing_consistent_weak_sharing_consistent [OF this] 
  have weak_consis: "weak_sharing_consistent 𝒪 sb".
  from read_only_unowned [OF i_bound ts_i]
  have owns_ro: "𝒪  read_only 𝒮 = {}".
  from read_only_share_all_acquired_in [OF owns_ro weak_consis a_ro_share]
  have "a  read_only (share sb Map.empty)  a  read_only 𝒮  a  all_acquired sb".
  moreover
  
  let ?take_sb = "(takeWhile (Not  is_volatile_Writesb) sb)"
  let ?drop_sb = "(dropWhile (Not  is_volatile_Writesb) sb)"

  from weak_consis weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
  obtain weak_consis': "weak_sharing_consistent (acquired True ?take_sb 𝒪) ?drop_sb" and
    weak_consis_take: "weak_sharing_consistent 𝒪 ?take_sb" 
    by auto
  
  {
    assume "a  read_only (share sb Map.empty)"
    with share_append [of ?take_sb ?drop_sb]
    have a_in': "a  read_only (share ?drop_sb (share ?take_sb Map.empty))"
      by auto

    have owns_empty: "𝒪  read_only Map.empty = {}"
      by auto

    from weak_sharing_consistent_preserves_distinct [OF weak_consis_take owns_empty]
    have "acquired True ?take_sb 𝒪  read_only (share ?take_sb Map.empty) = {}".

    from read_only_share_all_acquired_in [OF this weak_consis' a_in']
    have "a  read_only (share ?drop_sb Map.empty)  a  read_only (share ?take_sb Map.empty)  a  all_acquired ?drop_sb".
    moreover
    {
      assume a_ro_drop: "a  read_only (share ?drop_sb Map.empty)"
      have "read_only Map.empty  read_only (share_all_until_volatile_write ts 𝒮)"
	by auto
      from share_read_only_mono_in [OF a_ro_drop this]
      have ?thesis .
    }
    moreover
    {
      assume a_ro_take: "a  read_only (share ?take_sb Map.empty)" 
      assume a_unacq_drop: "a  all_acquired ?drop_sb"
      from read_only_share_unowned_in [OF weak_consis_take a_ro_take] 
      have "a  𝒪  all_acquired ?take_sb" by auto
      hence "a  𝒪  all_acquired sb" using all_acquired_append [of ?take_sb ?drop_sb]
        by auto
      from  share_all_until_volatile_write_thread_local' [OF dist consis i_bound ts_i this] a_ro_share
      have ?thesis by (auto simp add: read_only_def)
    }
    ultimately have ?thesis by blast
  }

  moreover

  {
    assume a_ro: "a  read_only 𝒮" 
    assume a_unacq: "a  all_acquired sb"
    with all_acquired_append [of ?take_sb ?drop_sb]
    obtain "a  all_acquired ?take_sb" and a_notin_drop: "a  all_acquired ?drop_sb"
      by auto
    with a_unacquired_others i_bound ts_i
    have a_unacq: "j < length ts. 
            (let (_,_,_,sbj,_,_,_) = ts!j in
            a  all_acquired (takeWhile (Not  is_volatile_Writesb) sbj))"
      by (auto simp add: Let_def)
    
    from local.weak_sharing_consis_axioms have "weak_sharing_consis ts" .
    from read_only_share_all_until_volatile_write_unacquired [OF dist ro_unowned 
      ‹weak_sharing_consis ts a_unacq a_ro]
    have a_ro_all: "a  read_only (share_all_until_volatile_write ts 𝒮)" .

    from weak_consis weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
    have weak_consis_drop: "weak_sharing_consistent (acquired True ?take_sb 𝒪) ?drop_sb"
      by auto

    from weak_sharing_consistent_preserves_distinct_share_all_until_volatile_write [OF dist 
      ro_unowned ‹weak_sharing_consis ts i_bound ts_i]
    have "acquired True ?take_sb 𝒪 
       read_only (share_all_until_volatile_write ts 𝒮) = {}".

    from read_only_unacquired_share [OF this weak_consis_drop a_ro_all a_notin_drop]
    have ?thesis .
  }
  ultimately show ?thesis by blast
qed

lemma all_acquired_dropWhile_in: "x  all_acquired (dropWhile P sb)  x  all_acquired sb"	
  using all_acquired_append [of "takeWhile P sb" "dropWhile P sb"]
  by auto


lemma all_acquired_takeWhile_in: "x  all_acquired (takeWhile P sb)  x  all_acquired sb"	
  using all_acquired_append [of "takeWhile P sb" "dropWhile P sb"]
  by auto

lemmas all_acquired_takeWhile_dropWhile_in = all_acquired_takeWhile_in all_acquired_dropWhile_in



lemma split_in_read_only_reads: 
  "𝒪. a  read_only_reads 𝒪 xs  
  (t v ys zs. xs=ys @ Readsb False a t v # zs  a  acquired True ys 𝒪)"
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x xs)
  have a_in: "a  read_only_reads 𝒪 (x#xs)" by fact
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      from a_in have "a  read_only_reads 𝒪 xs"
	by (auto simp add: Writesb False)
      from Cons.hyps [OF this] obtain t v ys zs where
	xs: "xs=ys@Readsb False a t v # zs" and a_notin: "a  acquired True ys 𝒪"
	by auto
      with xs a_notin obtain "x#xs=(x#ys)@Readsb False a t v # zs" "a  acquired True (x#ys) 𝒪"
	by (simp add: Writesb False)
      then show ?thesis
	by blast
    next
      case True
      from a_in have "a  read_only_reads (𝒪  A - R) xs"
	by (auto simp add: Writesb True)
      from Cons.hyps [OF this] obtain t v ys zs where
	xs: "xs=ys@Readsb False a t v # zs" and a_notin: "a  acquired True ys (𝒪  A - R)"
	by auto
      with xs a_notin obtain "x#xs=(x#ys)@Readsb False a t v # zs" "a  acquired True (x#ys) 𝒪"
	by (simp add: Writesb True)
      then show ?thesis
	by blast
    qed
  next
    case (Readsb volatile a' t' v')
    show ?thesis
    proof (cases "¬ volatile  a  𝒪  a'=a")
      case True
      with Readsb show ?thesis
	by fastforce
    next
      case False
      with a_in have "a  read_only_reads 𝒪 xs"	
	by (auto simp add: Readsb  split: if_split_asm)
      from Cons.hyps [OF this] obtain t v ys zs where
	xs: "xs=ys@Readsb False a t v # zs" and a_notin: "a  acquired True ys 𝒪"
	by auto
      with xs a_notin obtain "x#xs=(x#ys)@Readsb False a t v # zs" "a  acquired True (x#ys) 𝒪"
	by (simp add: Readsb)
      then show ?thesis
	by blast
    qed
  next
    case Progsb
    with a_in have "a  read_only_reads 𝒪 xs"	
      by (auto)
    from Cons.hyps [OF this] obtain t v ys zs where
      xs: "xs=ys@Readsb False a t v # zs" and a_notin: "a  acquired True ys 𝒪"
      by auto
    with xs a_notin obtain "x#xs=(x#ys)@Readsb False a t v # zs" "a  acquired True (x#ys) 𝒪"
      by (simp add: Progsb)
    then show ?thesis
      by blast
  next
    case (Ghostsb A L R W)
    with a_in have "a  read_only_reads (𝒪  A - R) xs"	
      by (auto)
    from Cons.hyps [OF this] obtain t v ys zs where
      xs: "xs=ys@Readsb False a t v # zs" and a_notin: "a  acquired True ys (𝒪  A -R)"
      by auto
    with xs a_notin obtain "x#xs=(x#ys)@Readsb False a t v # zs" "a  acquired True (x#ys) 𝒪"
      by (simp add: Ghostsb)
    then show ?thesis
      by blast
  qed
qed


lemma insert_monoD: "W  W'  insert a W  insert a W'"
  by blast


primrec unforwarded_non_volatile_reads:: "'a memref list  addr set  addr set"
where
"unforwarded_non_volatile_reads [] W = {}"
| "unforwarded_non_volatile_reads (x#xs) W =
  (case x of
     Readsb volatile a _ _  (if a  W  ¬ volatile 
                             then insert a (unforwarded_non_volatile_reads xs W) 
                             else  (unforwarded_non_volatile_reads xs W))
  | Writesb _ a _ _ _ _ _ _  unforwarded_non_volatile_reads xs (insert a W)
  | _  unforwarded_non_volatile_reads xs W)"


lemma unforwarded_non_volatile_reads_non_volatile_Readsb:
  "W. unforwarded_non_volatile_reads sb W  outstanding_refs is_non_volatile_Readsb sb"
apply (induct sb)
apply (auto split: memref.splits if_split_asm)
done

lemma in_unforwarded_non_volatile_reads_non_volatile_Readsb:
  "a  unforwarded_non_volatile_reads sb W  a  outstanding_refs is_non_volatile_Readsb sb"
using unforwarded_non_volatile_reads_non_volatile_Readsb
by blast


lemma unforwarded_non_volatile_reads_antimono:
 "W W'. W  W'  unforwarded_non_volatile_reads xs W'  unforwarded_non_volatile_reads xs W"
apply (induct xs)
apply (auto split: memref.splits dest: insert_monoD)
done

lemma unforwarded_non_volatile_reads_antimono_in:
 "x  unforwarded_non_volatile_reads xs W'  W  W'
   x  unforwarded_non_volatile_reads xs W"
  using unforwarded_non_volatile_reads_antimono
  by blast

lemma unforwarded_non_volatile_reads_append: "W. unforwarded_non_volatile_reads (xs@ys) W =
 (unforwarded_non_volatile_reads xs W  
  unforwarded_non_volatile_reads ys (W  outstanding_refs is_Writesb xs))"
apply (induct xs)
apply  clarsimp
apply (auto split: memref.splits)
done

lemma reads_consistent_mem_eq_on_unforwarded_non_volatile_reads:
  assumes mem_eq: "a  A  W. m' a = m a"
  assumes subset: "unforwarded_non_volatile_reads sb W  A"
  assumes consis_m: "reads_consistent pending_write 𝒪 m sb"
  shows "reads_consistent pending_write 𝒪 m' sb"
using mem_eq subset consis_m 
proof (induct sb arbitrary: A W m' m pending_write 𝒪)
  case Nil thus ?case by simp
next
  case (Cons r sb)
  note mem_eq = a  A  W. m' a = m a
  note subset = ‹unforwarded_non_volatile_reads (r#sb) W  A
  note consis_m = ‹reads_consistent pending_write 𝒪 m (r#sb)

  show ?case
  proof (cases r)
    case (Writesb volatile a sop v A' L R W')
    from subset obtain
      subset': "unforwarded_non_volatile_reads sb (insert a W)  A"
      by (auto simp add: Writesb)
    from mem_eq
    have mem_eq': 
      "a'  (A  (insert a W)). (m'(a:=v)) a' = (m(a:=v)) a'"
      by (auto)
    show ?thesis
    proof (cases volatile)
      case True
      from consis_m obtain
	consis': "reads_consistent True (𝒪  A' - R) (m(a := v)) sb" and
        no_volatile_Readsb: "outstanding_refs is_volatile_Readsb sb = {}" 
	by (simp add: Writesb True)

      from Cons.hyps [OF mem_eq' subset' consis']
      have "reads_consistent True (𝒪  A' - R) (m'(a := v)) sb".
      with no_volatile_Readsb 
      show ?thesis
	by (simp add: Writesb True)
    next
      case False
      from consis_m obtain consis': "reads_consistent pending_write 𝒪 (m(a := v)) sb" 
	by (simp add: Writesb False)
      from Cons.hyps [OF mem_eq' subset' consis']
      have "reads_consistent pending_write 𝒪 (m'(a := v)) sb".
      then
      show ?thesis
	by (simp add: Writesb False)
    qed
  next
    case (Readsb volatile a t v)
    from mem_eq
    have mem_eq': 
      "a'  A  W. m' a' = m a'"
      by (auto)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from consis_m obtain	
	consis': "reads_consistent pending_write 𝒪 m sb"  
	by (simp add: Readsb True)

      show ?thesis
      proof (cases "a  W")
	case False
	from subset obtain
	  subset': "unforwarded_non_volatile_reads sb W  A"
	  using False
	  by (auto simp add: Readsb True split: if_split_asm)
	from Cons.hyps [OF mem_eq' subset' consis']
	show ?thesis
	  by (simp add: Readsb True)
      next
	case True
	from subset have
	  subset': "unforwarded_non_volatile_reads sb W  
	             insert a A "
	  using True
	  apply (auto simp add: Readsb volatile split: if_split_asm)
	  done
	from mem_eq True have mem_eq': "a'  (insert a A)  W. m' a' = m a'"
	  by auto
	from Cons.hyps [OF mem_eq' subset' consis']
	show ?thesis
	  by (simp add: Readsb volatile)
      qed
    next
      case False
      note non_vol = this
      from consis_m obtain	
	consis': "reads_consistent pending_write 𝒪 m sb"  and 
	v: "(pending_write  a  𝒪)  v=m a" 
	by (simp add: Readsb False)
      show ?thesis
      proof (cases "a  W")
	case True
	from mem_eq subset Readsb True non_vol have "m' a = m a"
	  by (auto simp add: False)
	from subset obtain
	  subset': "unforwarded_non_volatile_reads sb W  insert a A"
	  using False
	  by (auto simp add: Readsb non_vol split: if_split_asm)
	from mem_eq True have mem_eq': "a'  (insert a A)  W. m' a' = m a'"
	  by auto

	with Cons.hyps [OF mem_eq' subset' consis'] v
	show ?thesis
	  by (simp add: Readsb non_vol)
      next
	case False
	from mem_eq subset Readsb False non_vol have meq: "m' a = m a"
	  by (clarsimp )
	from subset obtain
	  subset': "unforwarded_non_volatile_reads sb W  A"
	  using non_vol False
	  by (auto simp add: Readsb non_vol split: if_split_asm)
	from mem_eq non_vol have mem_eq': "a'  A  W. m' a' = m a'"
	  by auto
	with Cons.hyps [OF mem_eq' subset' consis'] v meq
	show ?thesis
	  by (simp add: Readsb non_vol False)
      qed
    qed
  next
    case Progsb with Cons show ?thesis by auto
  next
    case Ghostsb with Cons show ?thesis by auto
  qed
qed


lemma reads_consistent_mem_eq_on_unforwarded_non_volatile_reads_drop:
  assumes mem_eq: "a  A  W. m' a = m a"
  assumes subset: "unforwarded_non_volatile_reads (dropWhile (Not  is_volatile_Writesb) sb) W  A"
  assumes subset_acq: "acquired_reads True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪  A"
  assumes consis_m: "reads_consistent False 𝒪 m sb"
  shows "reads_consistent False 𝒪 m' sb"
using mem_eq subset subset_acq consis_m 
proof (induct sb arbitrary: A W m' m 𝒪)
  case Nil thus ?case by simp
next
  case (Cons r sb)
  note mem_eq = a  A  W. m' a = m a
  note subset = ‹unforwarded_non_volatile_reads 
    (dropWhile (Not  is_volatile_Writesb) (r#sb)) W  A
  note subset_acq = ‹acquired_reads True (takeWhile (Not  is_volatile_Writesb)(r#sb)) 𝒪  A
  note consis_m = ‹reads_consistent False 𝒪 m (r#sb)

  show ?case
  proof (cases r)
    case (Writesb volatile a sop v A' L R W')
    show ?thesis
    proof (cases volatile)
      case True
      from mem_eq
      have mem_eq': 
	"a'  (A  (insert a W)). (m'(a:=v)) a' = (m(a:=v)) a'"
	by (auto)

      from consis_m obtain
	consis': "reads_consistent True (𝒪  A' - R) (m(a := v)) sb" and
        no_volatile_Readsb: "outstanding_refs is_volatile_Readsb sb = {}" 
	by (simp add: Writesb True)

      from subset obtain "unforwarded_non_volatile_reads sb (insert a W)  A" 
	by (clarsimp simp add: Writesb True)

      from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads [OF mem_eq' this consis']
      have "reads_consistent True (𝒪  A' - R) (m'(a := v)) sb".
      with no_volatile_Readsb 
      show ?thesis
	by (simp add: Writesb True)
    next
      case False
      from mem_eq
      have mem_eq': 
	"a'  (A  W). (m'(a:=v)) a' = (m(a:=v)) a'"
	by (auto)
      from subset obtain
	subset': "unforwarded_non_volatile_reads (dropWhile (Not  is_volatile_Writesb) sb) W  A"
	by (auto simp add: Writesb False)
      from subset_acq have 
	subset_acq': "acquired_reads True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪  A"
	by (auto simp add: Writesb False)
	
      from consis_m obtain consis': "reads_consistent False 𝒪 (m(a := v)) sb" 
	by (simp add: Writesb False)
      from Cons.hyps [OF mem_eq' subset' subset_acq' consis']
      have "reads_consistent False 𝒪 (m'(a := v)) sb".
      then
      show ?thesis
	by (simp add: Writesb False)
    qed
  next
    case (Readsb volatile a t v)
    from mem_eq
    have mem_eq': 
      "a'  A  W. m' a' = m a'"
      by (auto)
    from subset obtain
      subset': "unforwarded_non_volatile_reads (dropWhile (Not  is_volatile_Writesb) sb) W  A"
      by (clarsimp simp add: Readsb)
    from subset_acq obtain
      a_A: "¬ volatile  a  𝒪  a  A" and
      subset_acq': "acquired_reads True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪  A"
      by (auto simp add: Readsb split: if_split_asm)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from consis_m obtain	
	consis': "reads_consistent False 𝒪 m sb"  
	by (simp add: Readsb True)
      
      from Cons.hyps [OF mem_eq' subset' subset_acq'  consis']
      show ?thesis
	by (simp add: Readsb True)
    next
      case False
      note non_vol = this
      from consis_m obtain	
	consis': "reads_consistent False 𝒪 m sb"  and 
	v: "a  𝒪  v=m a" 
	by (simp add: Readsb False)

      from mem_eq a_A v have v': "a  𝒪  v=m' a"
	by (auto simp add: non_vol)
      from Cons.hyps [OF mem_eq' subset' subset_acq'  consis'] v'
      show ?thesis
	by (simp add: Readsb False)
    qed
  next
    case Progsb with Cons show ?thesis by auto
  next
    case Ghostsb with Cons show ?thesis by auto
  qed
qed





(* FIXME: unused?*)
lemma read_only_read_witness:"𝒮 𝒪.
  non_volatile_owned_or_read_only True 𝒮 𝒪 sb;
   a  read_only_reads 𝒪 sb
   
  xs ys t v. sb=xs@ Readsb False a t v # ys  a  read_only (share xs 𝒮)  a  read_only_reads 𝒪 xs"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True

      from Cons.prems obtain 
	a_ro: "a  read_only_reads (𝒪  A - R) sb" and
	nvo': "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R) sb" 
	by (clarsimp simp add: Writesb True)

      from Cons.hyps [OF nvo' a_ro]
      obtain xs ys t v where
	"sb = xs @ Readsb False a t v # ys  a  read_only (share xs (𝒮W RA L))  
	a  read_only_reads (𝒪  A - R) xs"
	by blast
      
      thus ?thesis
	apply -
	apply (rule_tac x="(x#xs)" in exI)
	apply (rule_tac x=ys in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v in exI)
	apply (clarsimp simp add: Writesb True)
	done
    next
      case False
      from Cons.prems obtain 
	a_ro: "a  read_only_reads 𝒪 sb" and
	nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" 
	by (clarsimp simp add: Writesb False)

      from Cons.hyps [OF nvo' a_ro]
      obtain xs ys t v where
	"sb = xs @ Readsb False a t v # ys  a  read_only (share xs 𝒮)  a  read_only_reads 𝒪 xs"
	by blast
      
      thus ?thesis
	apply -
	apply (rule_tac x="(x#xs)" in exI)
	apply (rule_tac x=ys in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v in exI)
	apply (clarsimp simp add: Writesb False)
	done
    qed
  next
    case (Readsb volatile a' t v)
    show ?thesis
    proof (cases "a'=a  a  𝒪  ¬ volatile")
      case True
      with Cons.prems have "a  read_only 𝒮"
	by (simp add: Readsb)
      
      with True show ?thesis
	apply -
	apply (rule_tac x="[]" in exI)
	apply (rule_tac x="sb" in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v in exI)
	apply (clarsimp simp add: Readsb)
	done
    next
      case False
      with Cons.prems obtain 	
	a_ro: "a  read_only_reads 𝒪 sb" and
	nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" 
	by (auto simp add: Readsb split: if_split_asm)
      from Cons.hyps [OF nvo' a_ro]
      obtain xs ys t' v' where
	"sb = xs @ Readsb False a t' v' # ys  a  read_only (share xs 𝒮)  a  read_only_reads 𝒪 xs"
	by blast
      
      with False show ?thesis
	apply -
	apply (rule_tac x="(x#xs)" in exI)
	apply (rule_tac x=ys in exI)
	apply (rule_tac x=t' in exI)
	apply (rule_tac x=v' in exI)
	apply (clarsimp simp add: Readsb )
	done
    qed
  next
    case Progsb
    from Cons.prems obtain 
      a_ro: "a  read_only_reads 𝒪 sb" and
      nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" 
      by (clarsimp simp add: Progsb)
    
    from Cons.hyps [OF nvo' a_ro]
    obtain xs ys t v where
      "sb = xs @ Readsb False a t v # ys  a  read_only (share xs 𝒮)  a  read_only_reads 𝒪 xs"
      by blast
    
    thus ?thesis
      apply -
      apply (rule_tac x="(x#xs)" in exI)
      apply (rule_tac x=ys in exI)
      apply (rule_tac x=t in exI)
      apply (rule_tac x=v in exI)
      apply (clarsimp simp add: Progsb)
      done
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      a_ro: "a  read_only_reads (𝒪  A - R) sb" and
      nvo': "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R) sb" 
      by (clarsimp simp add: Ghostsb)
    
    from Cons.hyps [OF nvo' a_ro]
    obtain xs ys t v where
      "sb = xs @ Readsb False a t v # ys  a  read_only (share xs (𝒮W RA L))  a  read_only_reads (𝒪  A - R) xs"
      by blast
    
    thus ?thesis
      apply -
      apply (rule_tac x="(x#xs)" in exI)
      apply (rule_tac x=ys in exI)
      apply (rule_tac x=t in exI)
      apply (rule_tac x=v in exI)
      apply (clarsimp simp add: Ghostsb)
      done
  qed
qed

(* FIXME: unused?*)
lemma read_only_read_acquired_witness: "𝒮 𝒪.
  non_volatile_owned_or_read_only True 𝒮 𝒪 sb; sharing_consistent 𝒮 𝒪 sb;
  a  read_only 𝒮; a  𝒪; a  read_only_reads 𝒪 sb
   
  xs ys t v. sb=xs@ Readsb False a t v # ys  a  all_acquired xs  a  read_only (share xs 𝒮) 
              a  read_only_reads 𝒪 xs"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	nvo': "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R) sb" and
	a_nro: "a  read_only 𝒮" and
	a_unowned: "a  𝒪" and
	a_ro': "a  read_only_reads (𝒪  A - R) sb" and 
	A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and
	R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True)

      from R_owns a_unowned
      have a_R: "a  R"
	by auto
      show ?thesis
      proof (cases "a  A")
	case True
	from read_only_read_witness [OF nvo' a_ro']
	obtain xs ys t v' where
	  sb: "sb = xs @ Readsb False a t v' # ys" and
	  ro: "a  read_only (share xs (𝒮W RA L))" and
	  a_ro_xs: "a  read_only_reads (𝒪  A - R) xs"
	  by blast

	with True show ?thesis
	  apply -
	  apply (rule_tac x="x#xs" in exI)
	  apply (rule_tac x=ys in exI)
	  apply (rule_tac x=t in exI)
	  apply (rule_tac x=v' in exI)
	  apply (clarsimp simp add: Writesb volatile)
	  done
      next
	case False
	with a_unowned R_owns a_nro L_A A_R
	obtain a_nro': "a  read_only (𝒮W RA L)" and a_unowned': "a  𝒪  A - R"
	  by (force simp add: in_read_only_convs)

	from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_ro']
	obtain xs ys t v' where "sb = xs @ Readsb False a t v' # ys 
	  a  all_acquired xs  a  read_only (share xs (𝒮W RA L))  
	  a  read_only_reads (𝒪  A - R) xs"
	  by blast

	then show ?thesis
	  apply -
	  apply (rule_tac x="x#xs" in exI)
	  apply (rule_tac x=ys in exI)
	  apply (rule_tac x=t in exI)
	  apply (rule_tac x=v' in exI)
	  apply (clarsimp simp add: Writesb volatile)
	  done
      qed
    next
      case False
      from Cons.prems obtain 
	consis': "sharing_consistent 𝒮 𝒪 sb" and
	a_nro': "a  read_only 𝒮" and
	a_unowned: "a  𝒪" and
	a_ro': "a  read_only_reads 𝒪 sb" and
	"a'  𝒪" and
	nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
	by (clarsimp simp add: Writesb False)
      
      from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro']
      obtain xs ys t v' where
	"sb = xs @ Readsb False a t v' # ys 
         a  all_acquired xs  a  read_only (share xs 𝒮)  a  read_only_reads 𝒪 xs"
	by blast

      then show ?thesis
	apply -
	apply (rule_tac x="x#xs" in exI)
	apply (rule_tac x=ys in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v' in exI)
	apply (clarsimp simp add: Writesb False)
	done
    qed
  next
    case (Readsb volatile a' t v)
    from Cons.prems
    obtain 	
      consis': "sharing_consistent 𝒮 𝒪 sb" and
      a_nro': "a  read_only 𝒮" and
      a_unowned: "a  𝒪" and
      a_ro': "a  read_only_reads 𝒪 sb" and
      nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
      by (auto simp add: Readsb split: if_split_asm)

    from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro']
    obtain xs ys t v' where
      "sb = xs @ Readsb False a t v' # ys 
      a  all_acquired xs  a  read_only (share xs 𝒮)  a  read_only_reads 𝒪 xs"
      by blast

    with Cons.prems show ?thesis
      apply -
      apply (rule_tac x="x#xs" in exI)
      apply (rule_tac x=ys in exI)
      apply (rule_tac x=t in exI)
      apply (rule_tac x=v' in exI)
      apply (clarsimp simp add: Readsb)
      done
  next
    case Progsb
    from Cons.prems
    obtain 	
      consis': "sharing_consistent 𝒮 𝒪 sb" and
      a_nro': "a  read_only 𝒮" and
      a_unowned: "a  𝒪" and
      a_ro': "a  read_only_reads 𝒪 sb" and
      nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
      by (auto simp add: Progsb)

    from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro']
    obtain xs ys t v where
      "sb = xs @ Readsb False a t v # ys 
      a  all_acquired xs  a  read_only (share xs 𝒮)  a  read_only_reads 𝒪 xs"
      by blast

    then show ?thesis
      apply -
      apply (rule_tac x="x#xs" in exI)
      apply (rule_tac x=ys in exI)
      apply (rule_tac x=t in exI)
      apply (rule_tac x=v in exI)
      apply (clarsimp simp add: Progsb)
      done
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      nvo': "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R) sb" and
      a_nro: "a  read_only 𝒮" and
      a_unowned: "a  𝒪" and
      a_ro': "a  read_only_reads (𝒪  A - R) sb" and 
      A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and
      R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb)

    from R_owns a_unowned
    have a_R: "a  R"
      by auto
    show ?thesis
    proof (cases "a  A")
      case True
      from read_only_read_witness [OF nvo' a_ro']
      obtain xs ys t v' where
	sb: "sb = xs @ Readsb False a t v' # ys" and
	ro: "a  read_only (share xs (𝒮W RA L))" and
	a_ro_xs: "a  read_only_reads (𝒪  A - R) xs"
        by blast

      with True show ?thesis
        apply -
        apply (rule_tac x="x#xs" in exI)
        apply (rule_tac x=ys in exI)
        apply (rule_tac x=t in exI)
        apply (rule_tac x=v' in exI)
        apply (clarsimp simp add: Ghostsb)
        done
    next
      case False
      with a_unowned R_owns a_nro L_A A_R
      obtain a_nro': "a  read_only (𝒮W RA L)" and a_unowned': "a  𝒪  A - R"
        by (force simp add: in_read_only_convs)

      from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_ro']
      obtain xs ys t v' where "sb = xs @ Readsb False a t v' # ys 
	a  all_acquired xs  a  read_only (share xs (𝒮W RA L))  
	a  read_only_reads (𝒪  A - R) xs"
        by blast

      then show ?thesis
        apply -
	apply (rule_tac x="x#xs" in exI)
	apply (rule_tac x=ys in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v' in exI)
	apply (clarsimp simp add: Ghostsb)
	done
    qed
  qed
qed
    


lemma unforwarded_not_written: "W. a  unforwarded_non_volatile_reads sb W  a  W"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W')
    from Cons.prems
    have "a  unforwarded_non_volatile_reads sb (insert a' W)"
      by (clarsimp simp add: Writesb )
    from Cons.hyps [OF this]
    have "a  insert a' W".
    then show ?thesis
      by blast
  next
    case (Readsb volatile a' t v)
    with Cons.hyps [of W] Cons.prems show ?thesis
      by (auto split: if_split_asm)
  next
    case Progsb
    with Cons.hyps [of W] Cons.prems show ?thesis
      by (auto split: if_split_asm)
  next
    case Ghostsb
    with Cons.hyps [of W] Cons.prems show ?thesis
      by (auto split: if_split_asm)
  qed
qed

   
lemma unforwarded_witness:"X.
  a  unforwarded_non_volatile_reads sb X
   
  xs ys t v. sb=xs@ Readsb False a t v # ys  a  outstanding_refs is_Writesb xs"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      
      from Cons.prems obtain 
	a_unforw: "a  unforwarded_non_volatile_reads sb (insert a' X)" 
	by (clarsimp simp add: Writesb True)

      from unforwarded_not_written  [OF a_unforw]
      have a'_a: "a'a"
	by auto

      from Cons.hyps [OF a_unforw]
      obtain xs ys t v where
	"sb = xs @ Readsb False a t v # ys 
	a  outstanding_refs is_Writesb xs"
	by blast
      
      thus ?thesis
	using a'_a
	apply -
	apply (rule_tac x="(x#xs)" in exI)
	apply (rule_tac x=ys in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v in exI)
	apply (clarsimp simp add: Writesb True)
	done
    next
      case False
      from Cons.prems obtain 
	a_unforw: "a  unforwarded_non_volatile_reads sb (insert a' X)" 
	by (clarsimp simp add: Writesb False)

      from unforwarded_not_written  [OF a_unforw]
      have a'_a: "a'a"
	by auto

      from Cons.hyps [OF a_unforw] 
      obtain xs ys t v where
	"sb = xs @ Readsb False a t v # ys 
	a  outstanding_refs is_Writesb xs"
	by blast
      
      thus ?thesis
	using a'_a
	apply -
	apply (rule_tac x="(x#xs)" in exI)
	apply (rule_tac x=ys in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v in exI)
	apply (clarsimp simp add: Writesb False)
	done
    qed
  next
    case (Readsb volatile a' t v)
    show ?thesis
    proof (cases "a'=a  a  X  ¬ volatile")
      case True
      
      with True show ?thesis
	apply -
	apply (rule_tac x="[]" in exI)
	apply (rule_tac x="sb" in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v in exI)
	apply (clarsimp simp add: Readsb)
	done
    next
      case False
      note not_ror = this
      with Cons.prems obtain a_unforw: "a  unforwarded_non_volatile_reads sb X" 
	by (auto simp add: Readsb split: if_split_asm)

      from Cons.hyps [OF a_unforw]
      obtain xs ys t v where
	"sb = xs @ Readsb False a t v # ys 
	a  outstanding_refs is_Writesb xs"
	by blast
      
      thus ?thesis
	apply -
	apply (rule_tac x="(x#xs)" in exI)
	apply (rule_tac x=ys in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v in exI)
	apply (clarsimp simp add: Readsb)
	done
    qed
  next
    case Progsb
    from Cons.prems obtain a_unforw: "a  unforwarded_non_volatile_reads sb X" 
      by (auto simp add: Progsb)

    from Cons.hyps [OF a_unforw]
    obtain xs ys t v where
      "sb = xs @ Readsb False a t v # ys 
      a  outstanding_refs is_Writesb xs"
      by blast
    
    thus ?thesis
      apply -
      apply (rule_tac x="(x#xs)" in exI)
      apply (rule_tac x=ys in exI)
      apply (rule_tac x=t in exI)
      apply (rule_tac x=v in exI)
      apply (clarsimp simp add: Progsb)
      done
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain a_unforw: "a  unforwarded_non_volatile_reads sb X" 
      by (auto simp add: Ghostsb)

    from Cons.hyps [OF a_unforw]
    obtain xs ys t v where
      "sb = xs @ Readsb False a t v # ys 
      a  outstanding_refs is_Writesb xs"
      by blast
    
    thus ?thesis
      apply -
      apply (rule_tac x="(x#xs)" in exI)
      apply (rule_tac x=ys in exI)
      apply (rule_tac x=t in exI)
      apply (rule_tac x=v in exI)
      apply (clarsimp simp add: Ghostsb)
      done
  qed
qed


lemma read_only_read_acquired_unforwarded_witness: "𝒮 𝒪 X.
  non_volatile_owned_or_read_only True 𝒮 𝒪 sb; sharing_consistent 𝒮 𝒪 sb;
  a  read_only 𝒮; a  𝒪; a  read_only_reads 𝒪 sb;
  a  unforwarded_non_volatile_reads sb X 
   
  xs ys t v. sb=xs@ Readsb False a t v # ys  a  all_acquired xs 
              a  outstanding_refs is_Writesb xs"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	nvo': "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R) sb" and
	a_nro: "a  read_only 𝒮" and
	a_unowned: "a  𝒪" and
	a_ro': "a  read_only_reads (𝒪  A - R) sb" and 
	A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and
	R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and 
	a_unforw: "a  unforwarded_non_volatile_reads sb (insert a' X)" 
	by (clarsimp simp add: Writesb True)

      from unforwarded_not_written [OF a_unforw]
      have a_notin: "a  insert a' X".
      from R_owns a_unowned
      have a_R: "a  R"
	by auto
      show ?thesis
      proof (cases "a  A")
	case True

	from unforwarded_witness [OF a_unforw]
	obtain xs ys t v' where
	  sb: "sb = xs @ Readsb False a t v' # ys" and
	  a_xs: "a  outstanding_refs is_Writesb xs"
	  by blast

	with True a_notin show ?thesis
	  apply -
	  apply (rule_tac x="x#xs" in exI)
	  apply (rule_tac x=ys in exI)
	  apply (rule_tac x=t in exI)
	  apply (rule_tac x=v' in exI)
	  apply (clarsimp simp add: Writesb volatile)
	  done
      next
	case False
	with a_unowned R_owns a_nro L_A A_R
	obtain a_nro': "a  read_only (𝒮W RA L)" and a_unowned': "a  𝒪  A - R"
	  by (force simp add: in_read_only_convs)

	from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_ro' a_unforw]
	obtain xs ys t v' where "sb = xs @ Readsb False a t v' # ys 
	  a  all_acquired xs  
	  a  outstanding_refs is_Writesb xs"
	  by blast

	with a_notin show ?thesis
	  apply -
	  apply (rule_tac x="x#xs" in exI)
	  apply (rule_tac x=ys in exI)
	  apply (rule_tac x=t in exI)
	  apply (rule_tac x=v' in exI)
	  apply (clarsimp simp add: Writesb volatile)
	  done
      qed
    next
      case False
      from Cons.prems obtain 
	consis': "sharing_consistent 𝒮 𝒪 sb" and
	a_nro': "a  read_only 𝒮" and
	a_unowned: "a  𝒪" and
	a_ro': "a  read_only_reads 𝒪 sb" and
	"a'  𝒪" and
	nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and
	a_unforw': "a  unforwarded_non_volatile_reads sb (insert a' X)"
	by (auto simp add: Writesb False split: if_split_asm)
      
      from unforwarded_not_written [OF a_unforw']
      have a_notin: "a  insert a' X".

      from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro' a_unforw']
      obtain xs ys t v' where
	"sb = xs @ Readsb False a t v' # ys 
         a  all_acquired xs  a  outstanding_refs is_Writesb xs"
	by blast

      with a_notin show ?thesis
	apply -
	apply (rule_tac x="x#xs" in exI)
	apply (rule_tac x=ys in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v' in exI)
	apply (clarsimp simp add: Writesb False)
	done
    qed
  next
    case (Readsb volatile a' t v)
    from Cons.prems
    obtain 	
      consis': "sharing_consistent 𝒮 𝒪 sb" and
      a_nro': "a  read_only 𝒮" and
      a_unowned: "a  𝒪" and
      a_ro': "a  read_only_reads 𝒪 sb" and
      nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and 
      a_unforw: "a  unforwarded_non_volatile_reads sb X"
      by (auto simp add: Readsb split: if_split_asm)

    from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro' a_unforw]
    obtain xs ys t v' where
      "sb = xs @ Readsb False a t v' # ys 
      a  all_acquired xs  a  outstanding_refs is_Writesb xs"
      by blast

    with Cons.prems show ?thesis
      apply -
      apply (rule_tac x="x#xs" in exI)
      apply (rule_tac x=ys in exI)
      apply (rule_tac x=t in exI)
      apply (rule_tac x=v' in exI)
      apply (clarsimp simp add: Readsb)
      done
  next
    case Progsb
    from Cons.prems
    obtain 	
      consis': "sharing_consistent 𝒮 𝒪 sb" and
      a_nro': "a  read_only 𝒮" and
      a_unowned: "a  𝒪" and
      a_ro': "a  read_only_reads 𝒪 sb" and
      nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and 
      a_unforw: "a  unforwarded_non_volatile_reads sb X"
      by (auto simp add: Progsb)

    from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro' a_unforw]
    obtain xs ys t v where
      "sb = xs @ Readsb False a t v # ys 
      a  all_acquired xs  a  outstanding_refs is_Writesb xs"
      by blast

    then show ?thesis
      apply -
      apply (rule_tac x="x#xs" in exI)
      apply (rule_tac x=ys in exI)
      apply (rule_tac x=t in exI)
      apply (rule_tac x=v in exI)
      apply (clarsimp simp add: Progsb)
      done
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      nvo': "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R) sb" and
      a_nro: "a  read_only 𝒮" and
      a_unowned: "a  𝒪" and
      a_ro': "a  read_only_reads (𝒪  A - R) sb" and 
      A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and
      R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and 
      a_unforw: "a  unforwarded_non_volatile_reads sb (X)" 
      by (clarsimp simp add: Ghostsb)

    from unforwarded_not_written [OF a_unforw]
    have a_notin: "a  X".
    from R_owns a_unowned
    have a_R: "a  R"
      by auto
    show ?thesis
    proof (cases "a  A")
      case True

      from unforwarded_witness [OF a_unforw]
      obtain xs ys t v' where
	sb: "sb = xs @ Readsb False a t v' # ys" and
	a_xs: "a  outstanding_refs is_Writesb xs"
        by blast

      with True a_notin show ?thesis
        apply -
        apply (rule_tac x="x#xs" in exI)
        apply (rule_tac x=ys in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v' in exI)
	apply (clarsimp simp add: Ghostsb)
	done
    next
      case False
      with a_unowned R_owns a_nro L_A A_R
      obtain a_nro': "a  read_only (𝒮W RA L)" and a_unowned': "a  𝒪  A - R"
        by (force simp add: in_read_only_convs)

      from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_ro' a_unforw]
      obtain xs ys t v' where "sb = xs @ Readsb False a t v' # ys 
	a  all_acquired xs  
	a  outstanding_refs is_Writesb xs"
        by blast

      with a_notin show ?thesis
        apply -
	apply (rule_tac x="x#xs" in exI)
	apply (rule_tac x=ys in exI)
	apply (rule_tac x=t in exI)
	apply (rule_tac x=v' in exI)
	apply (clarsimp simp add: Ghostsb)
	done
    qed
  qed
qed


lemma takeWhile_prefix: "ys. takeWhile P xs @ ys = xs"
apply (induct xs)
apply auto
done

lemma unforwarded_empty_extend: 
  "W. x  unforwarded_non_volatile_reads sb {}   x  W  x  unforwarded_non_volatile_reads sb W"
apply (induct sb)
apply  clarsimp
subgoal for a sb W
apply (case_tac a) 
apply    clarsimp
apply    (frule unforwarded_not_written)
apply    (drule_tac W="{}" in unforwarded_non_volatile_reads_antimono_in)
apply    blast
apply   (auto split: if_split_asm)
done
done

lemma notin_unforwarded_empty: 
  "W. a  unforwarded_non_volatile_reads sb W  a  W  a  unforwarded_non_volatile_reads sb {}"
using unforwarded_empty_extend
by blast

lemma 
  assumes ro: "a  read_only 𝒮  a  read_only 𝒮'"
  assumes a_in: "a  read_only (𝒮W R) "
  shows "a  read_only (𝒮'W R) "
  using ro a_in
  by (auto simp add: in_read_only_convs)

lemma 
  assumes ro: "a  read_only 𝒮  a  read_only 𝒮'"
  assumes a_in: "a  read_only (𝒮A L) "
  shows "a  read_only (𝒮'A L) "
  using ro a_in
  by (auto simp add: in_read_only_convs)

lemma non_volatile_owned_or_read_only_read_only_reads_eq:
  "𝒮 𝒮' 𝒪 pending_write.
  non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb;
   a  read_only_reads 𝒪 sb. a  read_only 𝒮  a  read_only 𝒮' 
  
   non_volatile_owned_or_read_only pending_write 𝒮' 𝒪 sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	nvo': "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R) sb" and
	ro': "aread_only_reads (𝒪  A - R) sb. a  read_only 𝒮  a  read_only 𝒮'"
	by (clarsimp simp add: Writesb volatile)

      from ro'
      have ro'':"aread_only_reads (𝒪  A - R) sb.
        a  read_only (𝒮W RA L)  a  read_only (𝒮'W RA L)"
	by (auto simp add: in_read_only_convs)
      from Cons.hyps [OF nvo' ro'']
      show ?thesis
	by (clarsimp simp add: Writesb volatile)
    next
      case False
      with Cons.hyps [of pending_write 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case (Readsb volatile a t v)
    show ?thesis
    proof (cases volatile)
      case True
      with Cons.hyps [of pending_write 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
	by (auto simp add: Readsb)
    next
      case False
      note non_vol = this
      show ?thesis
      proof (cases "a  𝒪")
	case True
	with Cons.hyps [of pending_write 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
	  by (auto simp add: Readsb non_vol)
      next
	case False
	from Cons.prems Cons.hyps [of pending_write 𝒮 𝒪 𝒮'] show ?thesis 
	  by (clarsimp simp add: Readsb non_vol False)
      qed
    qed
  next
    case Progsb
    with Cons.hyps [of pending_write 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
      by (auto)
  next
    case (Ghostsb A L R W)
    from Cons.hyps [of pending_write "(𝒮W RA L)" "𝒪  A - R" "𝒮'W RA L"] Cons.prems
    show ?thesis
      by (auto simp add: Ghostsb in_read_only_convs)
  qed
qed


lemma non_volatile_owned_or_read_only_read_only_reads_eq':
  "𝒮 𝒮' 𝒪.
  non_volatile_owned_or_read_only False 𝒮 𝒪 sb;
   a  read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪) 
         (dropWhile (Not  is_volatile_Writesb) sb). a  read_only 𝒮  a  read_only 𝒮' 
  
   non_volatile_owned_or_read_only False 𝒮' 𝒪 sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	nvo': "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R) sb" and
	ro': "aread_only_reads (𝒪  A - R) sb. a  read_only 𝒮  a  read_only 𝒮'"
	by (clarsimp simp add: Writesb volatile)

      from ro'
      have ro'':"aread_only_reads (𝒪  A - R) sb.
        a  read_only (𝒮W RA L)  a  read_only (𝒮'W RA L)"
	by (auto simp add: in_read_only_convs)
      from non_volatile_owned_or_read_only_read_only_reads_eq [OF nvo' ro'']
      show ?thesis
	by (clarsimp simp add: Writesb volatile)
    next
      case False
      with Cons.hyps [of 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case (Readsb volatile a t v)
    show ?thesis
    proof (cases volatile)
      case True
      with Cons.hyps [of 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
	by (auto simp add: Readsb)
    next
      case False
      note non_vol = this
      show ?thesis
      proof (cases "a  𝒪")
	case True
	with Cons.hyps [of 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
	  by (auto simp add: Readsb non_vol)
      next
	case False
	from Cons.prems Cons.hyps [of 𝒮 𝒪 𝒮'] show ?thesis 
	  by (clarsimp simp add: Readsb non_vol False)
      qed
    qed
  next
    case Progsb
    with Cons.hyps [of 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
      by (auto)
  next
    case (Ghostsb A L R W)
    from Cons.hyps [of "(𝒮W RA L)" "𝒪  A - R" "𝒮'W RA L"] Cons.prems
    show ?thesis
      by (auto simp add: Ghostsb in_read_only_convs)
  qed
qed


lemma no_write_to_read_only_memory_read_only_reads_eq:
  "𝒮 𝒮'.
  no_write_to_read_only_memory 𝒮 sb;
   a  outstanding_refs is_Writesb sb. a  read_only 𝒮'  a  read_only 𝒮 
  
   no_write_to_read_only_memory 𝒮' sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	nvo': "no_write_to_read_only_memory (𝒮W RA L) sb" and
	ro': "aoutstanding_refs is_Writesb sb. a  read_only 𝒮'  a  read_only 𝒮" and
	not_ro: "a  read_only 𝒮'"
	by (auto simp add: Writesb volatile)

      from ro'
      have ro'':"aoutstanding_refs is_Writesb sb.
        a  read_only (𝒮'W RA L)  a  read_only (𝒮W RA L)"
	by (auto simp add: in_read_only_convs)
      from Cons.hyps [OF nvo' ro''] not_ro
      show ?thesis
	by (clarsimp simp add: Writesb volatile)
    next
      case False
      with Cons.hyps [of 𝒮 𝒮'] Cons.prems show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case (Readsb volatile a t v)
    with Cons.hyps [of 𝒮 𝒮'] Cons.prems show ?thesis
      by (auto simp add: Readsb)  
  next
    case Progsb
    with Cons.hyps [of 𝒮 𝒮'] Cons.prems show ?thesis
      by (auto)
  next
    case (Ghostsb A L R W)
    from Cons.hyps [of "(𝒮W RA L)" "𝒮'W RA L"] Cons.prems
    show ?thesis
      by (auto simp add: Ghostsb in_read_only_convs)
  qed
qed


lemma reads_consistent_drop:
  "reads_consistent False 𝒪 m sb
   reads_consistent True  
      (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪) 
      (flush (takeWhile (Not  is_volatile_Writesb) sb) m)
      (dropWhile (Not  is_volatile_Writesb) sb)"
using reads_consistent_append [of False 𝒪 m "(takeWhile (Not  is_volatile_Writesb) sb)" 
  "(dropWhile (Not  is_volatile_Writesb) sb)"]
apply (cases "outstanding_refs is_volatile_Writesb sb = {}")
apply  (clarsimp simp add: outstanding_vol_write_take_drop_appends 
  takeWhile_not_vol_write_outstanding_refs dropWhile_not_vol_write_empty)
apply(clarsimp simp add: outstanding_vol_write_take_drop_appends 
  takeWhile_not_vol_write_outstanding_refs dropWhile_not_vol_write_empty )
apply (case_tac "(dropWhile (Not  is_volatile_Writesb) sb)")
apply  (fastforce simp add: outstanding_refs_conv)
apply (frule dropWhile_ConsD)
apply (clarsimp split: memref.splits)
done

(* FIXME: subsumes outstanding_refs_non_volatile_Readsb_all_acquired_drop *)
lemma outstanding_refs_non_volatile_Readsb_all_acquired_dropWhile': 
"m 𝒮 𝒪 pending_write. 
  reads_consistent pending_write 𝒪 m sb;non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb;  
a  outstanding_refs is_non_volatile_Readsb (dropWhile (Not  is_volatile_Writesb) sb)
 a  𝒪  a  all_acquired sb 
    a  read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪) 
      (dropWhile (Not  is_volatile_Writesb) sb)"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	non_vo: "non_volatile_owned_or_read_only True (𝒮W RA L) 
	            (𝒪  A - R) sb" and
        out_vol: "outstanding_refs is_volatile_Readsb sb = {}" and
	out: "a  outstanding_refs is_non_volatile_Readsb sb"
	by (clarsimp simp add: Writesb True) 
      show ?thesis
      proof (cases "a  𝒪")
	case True
	show ?thesis
	by (clarsimp simp add: Writesb True volatile)
      next
	case False
	from outstanding_non_volatile_Readsb_acquired_or_read_only_reads [OF non_vo out]
	have a_in: "a  acquired_reads True sb (𝒪  A - R) 
                    a  read_only_reads (𝒪  A - R) sb"
	  by auto
	with acquired_reads_all_acquired [of True sb "(𝒪  A - R)"]
	show ?thesis 
	  by (auto simp add: Writesb volatile)
      qed

    next
      case False
      with Cons show ?thesis
	by (auto simp add: Writesb False)
    qed
  next
    case Readsb
    with Cons show ?thesis
      apply (clarsimp simp del: o_apply simp add: Readsb 
	acquired_takeWhile_non_volatile_Writesb split: if_split_asm)
      apply auto
      done
  next
    case Progsb
    with Cons show ?thesis
      by (auto simp add: Readsb)
  next
    case (Ghostsb A L R W)
    with Cons.hyps [of pending_write "𝒪  A - R" "m" "𝒮W RA L"]  read_only_reads_antimono [of 𝒪 "𝒪  A - R"]
      Cons.prems show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed



end

Theory ReduceStoreBufferSimulation

(* Copyright (C) 2007--2010 Norbert Schirmer
 * All rights reserved, DFKI GmbH 
 *)
theory ReduceStoreBufferSimulation
imports ReduceStoreBuffer
begin

(* FIXME: a lot of theorems that now have sharing_consistent as precondition, may as well work with weak_sharing_consistent
 *)

locale initialsb = simple_ownership_distinct + read_only_unowned + unowned_shared +
constrains ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes empty_sb: "i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,)  sb=[]"
assumes empty_is: "i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,)  is=[]"
assumes empty_rels: "i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,)  =Map.empty"


sublocale initialsb  outstanding_non_volatile_refs_owned_or_read_only
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "non_volatile_owned_or_read_only False 𝒮 𝒪 sb"
   using empty_sb [OF i_bound ts_i] by auto
qed

sublocale initialsb  outstanding_volatile_writes_unowned_by_others
proof
  fix i j pi isi 𝒪i i 𝒟i θi sbi pj isj 𝒪j j 𝒟j θj sbj
  assume i_bound: "i < length ts" and 
    j_bound: "j < length ts" and
    neq_i_j: "i  j" and
    ts_i: "ts ! i = (pi, isi, θi, sbi, 𝒟i, 𝒪i, i)" and
    ts_j: "ts ! j = (pj, isj, θj, sbj, 𝒟j, 𝒪j, j)" 
  show "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sbi = {}"
  using empty_sb [OF i_bound ts_i] empty_sb [OF j_bound ts_j] by auto
qed

sublocale initialsb  read_only_reads_unowned
proof
  fix i j pi isi 𝒪i i 𝒟i θi sbi pj isj 𝒪j j 𝒟j θj sbj
  assume i_bound: "i < length ts" and 
    j_bound: "j < length ts" and
    neq_i_j: "i  j" and
    ts_i: "ts ! i = (pi, isi, θi, sbi, 𝒟i, 𝒪i, i)" and
    ts_j: "ts ! j = (pj, isj, θj, sbj, 𝒟j, 𝒪j, j)" 
  show "(𝒪j  all_acquired sbj)  
     read_only_reads (acquired True 
                          (takeWhile (Not  is_volatile_Writesb) sbi) 𝒪i) 
                          (dropWhile (Not  is_volatile_Writesb) sbi) = {}"
  using empty_sb [OF i_bound ts_i] empty_sb [OF j_bound ts_j] by auto
qed

sublocale initialsb  ownership_distinct
proof
  fix i j pi isi 𝒪i i 𝒟i θi sbi pj isj 𝒪j j 𝒟j θj sbj
  assume i_bound: "i < length ts" and 
    j_bound: "j < length ts" and
    neq_i_j: "i  j" and
    ts_i: "ts ! i = (pi, isi, θi, sbi, 𝒟i, 𝒪i, i)" and
    ts_j: "ts ! j = (pj, isj, θj, sbj, 𝒟j, 𝒪j, j)" 
  show "(𝒪i  all_acquired sbi)  (𝒪j  all_acquired sbj) = {}"
  using simple_ownership_distinct [OF i_bound j_bound neq_i_j ts_i ts_j] empty_sb [OF i_bound ts_i] empty_sb [OF j_bound ts_j]
  by auto
qed


sublocale initialsb  valid_ownership ..

sublocale initialsb  outstanding_non_volatile_writes_unshared
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "non_volatile_writes_unshared 𝒮 sb"
   using empty_sb [OF i_bound ts_i] by auto
qed

sublocale initialsb  sharing_consis
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "sharing_consistent 𝒮 𝒪 sb"
   using empty_sb [OF i_bound ts_i] by auto
qed

sublocale initialsb  no_outstanding_write_to_read_only_memory
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "no_write_to_read_only_memory 𝒮 sb"
   using empty_sb [OF i_bound ts_i] by auto
qed

sublocale initialsb  valid_sharing ..
sublocale initialsb  valid_ownership_and_sharing ..

sublocale initialsb  load_tmps_distinct
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "distinct_load_tmps is"
   using empty_is [OF i_bound ts_i] by auto
qed

sublocale initialsb  read_tmps_distinct
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "distinct_read_tmps sb"
   using empty_sb [OF i_bound ts_i] by auto
qed

sublocale initialsb  load_tmps_read_tmps_distinct
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "load_tmps is  read_tmps sb = {}"
   using empty_sb [OF i_bound ts_i] empty_is [OF i_bound ts_i] by auto
qed

sublocale initialsb  load_tmps_read_tmps_distinct ..

sublocale initialsb  valid_write_sops
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "sop  write_sops sb. valid_sop sop"
   using empty_sb [OF i_bound ts_i] by auto
qed

sublocale initialsb  valid_store_sops
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "sop  store_sops is. valid_sop sop"
   using empty_is [OF i_bound ts_i] by auto
qed

sublocale initialsb  valid_sops ..

sublocale initialsb  valid_reads
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "reads_consistent False 𝒪 m sb"
   using empty_sb [OF i_bound ts_i] by auto
qed

sublocale initialsb  valid_history
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "program.history_consistent program_step θ (hd_prog p sb) sb"
   using empty_sb [OF i_bound ts_i] by (auto simp add: program.history_consistent.simps)
qed

sublocale initialsb  valid_data_dependency
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "data_dependency_consistent_instrs (dom θ) is"
   using empty_is [OF i_bound ts_i] by auto
next
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "load_tmps is  (fst ` write_sops sb) = {}"
   using empty_is [OF i_bound ts_i] empty_sb [OF i_bound ts_i] by auto
qed

sublocale initialsb  load_tmps_fresh
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "load_tmps is  dom θ = {}"
   using empty_is [OF i_bound ts_i] by auto
qed

sublocale initialsb  enough_flushs
proof
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "outstanding_refs is_volatile_Writesb sb = {}"
   using empty_sb [OF i_bound ts_i] by auto
qed

sublocale initialsb  valid_program_history
proof
   fix i "is" 𝒪  𝒟 θ sb p sb1 sb2
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   assume sb: "sb=sb1@sb2"
   show "isa. instrs sb2 @ is = isa @ prog_instrs sb2"
   using empty_sb [OF i_bound ts_i] empty_is [OF i_bound ts_i] sb by auto
next
   fix i "is" 𝒪  𝒟 θ sb p
   assume i_bound: "i < length ts"
   assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
   show "last_prog p sb = p"
   using empty_sb [OF i_bound ts_i] by auto
qed


inductive 
  sim_config:: "('p,'p store_buffer,bool,owns,rels) thread_config list × memory × shared  
                ('p, unit,bool,owns,rels) thread_config list × memory × shared   bool" 
 ("_  _" [60,60] 100)
where
  "m = flush_all_until_volatile_write tssb msb;
    𝒮 = share_all_until_volatile_write tssb 𝒮sb;
    length tssb = length ts; 
    i < length tssb. 
           let (p, issb, θ, sb, 𝒟sb, 𝒪, ) = tssb!i;
               suspends = dropWhile (Not  is_volatile_Writesb) sb
            in  is 𝒟. instrs suspends @ issb = is @ prog_instrs suspends 
                    𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb sb  {}) 
                ts!i = (hd_prog p suspends, 
                        is,
                        θ |` (dom θ - read_tmps suspends),(),
                        𝒟,  
                        acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪,
                        release (takeWhile (Not  is_volatile_Writesb) sb) (dom 𝒮sb)  )
    
     
     (tssb,msb,𝒮sb)  (ts,m,𝒮)"

text ‹The machine without
history only stores writes in the store-buffer.›
inductive sim_history_config:: 
 "('p,'p store_buffer,'dirty,'owns,'rels) thread_config list  ('p,'p store_buffer,bool,owns,rels) thread_config list  bool" 
  ("_ h _ " [60,60] 100)
where
  "length ts = length tsh; 
    i < length ts. 
         (𝒪' 𝒟' ℛ'.
           let (p,is, θ, sb,𝒟, 𝒪,) = tsh!i in 
                ts!i=(p,is, θ, filter is_Writesb sb,𝒟',𝒪',ℛ') 
                (filter is_Writesb sb = []  sb=[]))
    
     
     ts h tsh"

lemma (in initialsb) history_refl:"ts h ts"
apply -
apply (rule sim_history_config.intros)
apply  simp 
apply clarsimp
subgoal for i
apply (case_tac "ts!i")
apply (drule_tac  i=i in empty_sb)
apply  assumption
apply auto
done
done

lemma share_all_empty: "i p is xs sb 𝒟 𝒪 . i < length ts  ts!i=(p,is,xs,sb,𝒟,𝒪,) sb=[]
   share_all_until_volatile_write ts 𝒮 = 𝒮"
apply (induct ts)
apply  clarsimp
apply clarsimp
apply (frule_tac x=0 in spec)
apply clarsimp
apply force
done

lemma flush_all_empty: "i p is xs sb 𝒟 𝒪 . i < length ts  ts!i=(p,is,xs,sb,𝒟,𝒪,) sb=[]
   flush_all_until_volatile_write ts m = m"
apply (induct ts)
apply  clarsimp
apply clarsimp
apply (frule_tac x=0 in spec)
apply clarsimp
apply force
done

lemma sim_config_emptyE: 
  assumes empty:
  "i p is xs sb 𝒟 𝒪 . i < length tssb  tssb!i=(p,is,xs,sb,𝒟,𝒪,) sb=[]"
  assumes sim: "(tssb,msb,𝒮sb)  (ts,m,𝒮)"
  shows "𝒮 = 𝒮sb  m = msb  length ts = length tssb 
         (i < length tssb. 
           let (p, is, θ, sb, 𝒟, 𝒪, ) = tssb!i
            in ts!i = (p, is, θ, (), 𝒟, 𝒪, ))"
proof -
  from sim
  show ?thesis
  apply cases
  apply (clarsimp simp add: flush_all_empty [OF empty] share_all_empty [OF empty])
  subgoal for i
  apply (drule_tac x=i in spec)
  apply (cut_tac i=i in empty [rule_format])
  apply clarsimp
  apply assumption
  apply (auto simp add: Let_def)
  done
  done
qed

lemma sim_config_emptyI:
  assumes empty:
  "i p is xs sb 𝒟 𝒪 . i < length tssb  tssb!i=(p,is,xs,sb,𝒟,𝒪,) sb=[]"
  assumes leq: "length ts = length tssb"
  assumes ts: "(i < length tssb. 
           let (p, is, θ, sb, 𝒟, 𝒪, ) = tssb!i
            in ts!i = (p, is, θ, (), 𝒟, 𝒪, ))"
  shows "(tssb,msb,𝒮sb)  (ts,msb,𝒮sb)"
apply (rule sim_config.intros) 
apply    (simp add: flush_all_empty [OF empty])
apply   (simp add: share_all_empty [OF empty])
apply  (simp add: leq)
apply (clarsimp)
apply (frule (1) empty [rule_format])
using ts
apply (auto simp add: Let_def)
done
lemma mem_eq_un_eq: "length ts'=length ts; i< length ts'. P (ts'!i) = Q (ts!i)   (xset ts'. P x) = (xset ts. Q x)"
apply (auto simp add: in_set_conv_nth )
apply  (force dest!: nth_mem)
apply (frule nth_mem)
subgoal for x i
apply (drule_tac x=i in spec)
apply auto
done
done

(* FIXME: move up *)
lemma (in program) trace_to_steps: 
assumes trace: "trace c 0 k" 
shows steps: "c 0 d* c k"
using trace
proof (induct k)
  case 0
  show "c 0 d* c 0"
    by auto
next
  case (Suc k)
  have prem: "trace c 0 (Suc k)" by fact
  hence "trace c 0 k" 
    by (auto simp add: program_trace_def)
  from Suc.hyps [OF this]
  have "c 0 d* c k" .
  also
  term program_trace
  from prem interpret program_trace program_step  c 0 "Suc k" .
  from step [of k] have "c (k) d c (Suc k)"
    by auto
  finally show ?case .
qed

lemma (in program) safe_reach_to_safe_reach_upto:
  assumes safe_reach: "safe_reach_direct safe c0"
  shows "safe_reach_upto n safe c0"
proof
  fix k c l
  assume k_n: "k  n"
  assume trace: "trace c 0 k"
  assume c_0: "c 0 = c0"
  assume l_k: "l  k"
  show "safe (c l)"
  proof -
    from trace k_n l_k have trace': "trace c 0 l"
      by (auto simp add: program_trace_def)
    from trace_to_steps [OF trace']
    have "c 0 d* c l".
    with safe_reach c_0 show "safe (c l)"
    by (cases "c l") (auto simp add: safe_reach_def)
  qed
qed

lemma (in program_progress) safe_free_flowing_implies_safe_delayed':
  assumes init: "initialsb tssb 𝒮sb"
  assumes sim: "(tssb,msb,𝒮sb)  (ts,m,𝒮)"
  assumes safe_reach_ff: "safe_reach_direct safe_free_flowing (ts,m,𝒮)"
  shows "safe_reach_direct safe_delayed (ts,m,𝒮)"
proof - 
  from init
  interpret ini: initialsb tssb 𝒮sb .
  from sim obtain
   m: "m = flush_all_until_volatile_write tssb msb" and
   𝒮: "𝒮 = share_all_until_volatile_write tssb 𝒮sb" and
   leq: "length tssb = length ts" and
   t_sim: "i < length tssb. 
           let (p, issb, θ, sb, 𝒟sb, 𝒪, ) = tssb!i;
               suspends = dropWhile (Not  is_volatile_Writesb) sb
            in  is 𝒟. instrs suspends @ issb = is @ prog_instrs suspends 
                    𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb sb  {}) 
                ts!i = (hd_prog p suspends, 
                        is,
                        θ |` (dom θ - read_tmps suspends),(),
                        𝒟,  
                        acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪,
                        release (takeWhile (Not  is_volatile_Writesb) sb) (dom 𝒮sb)  )"
    by cases auto

  from ini.empty_sb  
  have shared_eq: "𝒮 = 𝒮sb"
    apply (simp only: 𝒮)
    apply (rule share_all_empty)
    apply force
    done
  have sd: "simple_ownership_distinct ts"
  proof 
    fix i j pi isi 𝒪i i 𝒟i θi sbi pj isj 𝒪j j 𝒟j θj sbj
    assume i_bound: "i < length ts" and 
      j_bound: "j < length ts" and
      neq_i_j: "i  j" and
      ts_i: "ts ! i = (pi, isi, θi, sbi, 𝒟i, 𝒪i, i)" and
      ts_j: "ts ! j = (pj, isj, θj, sbj, 𝒟j, 𝒪j, j)" 
    show "(𝒪i)  (𝒪j ) = {}"
    proof -
      from t_sim [simplified leq, rule_format, OF i_bound] ini.empty_sb [simplified leq, OF i_bound]
      have ts_i: "tssb!i = (pi,isi,θi,[],𝒟i,𝒪i,i)"
      using ts_i
        by (force simp add: Let_def)
      from t_sim [simplified leq, rule_format, OF j_bound] ini.empty_sb [simplified leq, OF j_bound]
      have ts_j: "tssb!j = (pj,isj,θj,[],𝒟j,𝒪j,j)"
      using ts_j
        by (force simp add: Let_def)
      from ini.simple_ownership_distinct [simplified leq, OF i_bound j_bound neq_i_j ts_i ts_j]
      show ?thesis .
    qed
  qed
  have ro: "read_only_unowned 𝒮 ts"
  proof 
    fix i "is" 𝒪  𝒟 θ sb p
    assume i_bound: "i < length ts"
    assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
    show "𝒪  read_only 𝒮 = {}"
    proof -
      from t_sim [simplified leq, rule_format, OF i_bound] ini.empty_sb [simplified leq, OF i_bound]
      have ts_i: "tssb!i = (p,is,θ,[],𝒟,𝒪,)"
      using ts_i
        by (force simp add: Let_def)
      from ini.read_only_unowned [simplified leq, OF i_bound ts_i] shared_eq
      show ?thesis by simp
    qed
  qed
  have us: "unowned_shared 𝒮 ts"
  proof 
    show "- (((λ(_, _, _, _, _, 𝒪, _). 𝒪) ` set ts))  dom 𝒮"
    proof -
      have "(((λ(_, _, _, _, _, 𝒪, _). 𝒪) ` set tssb)) = (((λ(_, _, _, _, _, 𝒪, _). 𝒪) ` set ts))"
        apply clarsimp
        apply (rule mem_eq_un_eq)
        apply (simp add: leq)
        apply clarsimp
        apply (frule t_sim [rule_format])
        apply (clarsimp simp add: Let_def)
        apply (drule (1) ini.empty_sb)
        apply auto
        done
      with ini.unowned_shared show ?thesis by (simp only: shared_eq)
    qed
  qed
  {
    fix i "is" 𝒪  𝒟 θ sb p
    assume i_bound: "i < length ts"
    assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
    have " = Map.empty"
    proof -
      from t_sim [simplified leq, rule_format, OF i_bound] ini.empty_sb [simplified leq, OF i_bound]
      have ts_i: "tssb!i = (p,is,θ,[],𝒟,𝒪,)"
      using ts_i
        by (force simp add: Let_def)
      from ini.empty_rels [simplified leq, OF i_bound ts_i]
      show ?thesis .
    qed
  }
  with us have initial: "initial (ts, m, 𝒮)"
    by (fastforce simp add: initial_def)
  
  {
    fix ts' 𝒮' m'
    assume steps: "(ts,m,𝒮) d* (ts',m',𝒮')"
    have "safe_delayed (ts',m',𝒮')"
    proof -
      from steps_to_trace [OF steps] obtain c k
      where trace: "trace c 0 k" and c_0: "c 0 = (ts,m,𝒮)" and c_k: "c k = (ts',m',𝒮')"
        by auto
      from safe_reach_to_safe_reach_upto [OF safe_reach_ff]
      have safe_upto_k: "safe_reach_upto k safe_free_flowing (ts, m, 𝒮)".
      from safe_free_flowing_implies_safe_delayed [OF _ _ _ _ safe_upto_k, simplified, OF initial sd ro us]
      have "safe_reach_upto k safe_delayed (ts, m, 𝒮)".
      then interpret program_safe_reach_upto program_step k safe_delayed "(ts,m,𝒮)" .
      from safe_config [where c=c and k=k and l=k, OF _ trace c_0] c_k show ?thesis by simp
    qed
  }
  then show ?thesis
    by (clarsimp simp add: safe_reach_def)
qed

(* FIXME: move up *)
lemma map_onws_sb_owned:"j. j < length ts  map 𝒪_sb ts ! j = (𝒪j,sbj)  map owned ts ! j = 𝒪j"
apply (induct ts)
apply  simp 
subgoal for t ts j
apply (case_tac j)
apply  (case_tac t)
apply  auto
done
done


lemma map_onws_sb_owned':"j. j < length ts  𝒪_sb (ts ! j) = (𝒪j,sbj)  owned (ts ! j) = 𝒪j"
apply (induct ts)
apply  simp
subgoal for t ts j
apply (case_tac j)
apply  (case_tac t)
apply  auto
done
done

(* FIXME: substitutes in application below: read_only_read_acquired_unforwarded_witness*)
lemma read_only_read_acquired_unforwarded_acquire_witness:
  "𝒮 𝒪 X.non_volatile_owned_or_read_only True 𝒮 𝒪 sb;
 sharing_consistent 𝒮 𝒪 sb; a  read_only 𝒮; a  𝒪;
 a  unforwarded_non_volatile_reads sb X
(sop a' v ys zs A L R W. 
     sb = ys @ Writesb True a' sop v A L R W # zs  
     a  A  a  outstanding_refs is_Writesb ys  a'  a) 
(A L R W ys zs. sb = ys @ Ghostsb A L R W# zs  a  A  a  outstanding_refs is_Writesb ys)"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain 
	nvo': "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R) sb" and
	a_nro: "a  read_only 𝒮" and
	a_unowned: "a  𝒪" and
	A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and
	R_owns: "R  𝒪" and
	consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and 
	a_unforw: "a  unforwarded_non_volatile_reads sb (insert a' X)" 
	by (clarsimp simp add: Writesb True)
      from unforwarded_not_written [OF a_unforw]
      have a_notin: "a  insert a' X".
      hence a'_a: "a'  a"
        by simp
      from R_owns a_unowned
      have a_R: "a  R"
	by auto
      show ?thesis
      proof (cases "a  A")
	case True
	then show ?thesis
	  apply -
	  apply (rule disjI1)
	  apply (rule_tac x=sop in exI)
	  apply (rule_tac x=a' in exI)	
	  apply (rule_tac x=v in exI)	
	  apply (rule_tac x="[]" in exI)	
	  apply (rule_tac x=sb in exI)	
	  apply (simp add: Writesb volatile True a'_a)
	  done
      next
	case False
	with a_unowned R_owns a_nro L_A A_R
	obtain a_nro': "a  read_only (𝒮W RA L)" and a_unowned': "a  𝒪  A - R"
	  by (force simp add: in_read_only_convs)

	from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_unforw]
	have "(sop a' v ys zs A L R W.
                 sb = ys @ Writesb True a' sop v A L R W # zs 
                 a  A  a  outstanding_refs is_Writesb ys  a'  a) 
              (A L R W ys zs. sb = ys @ Ghostsb A L R W# zs  a  A  a  outstanding_refs is_Writesb ys)"
              (is "?write  ?ghst")
	  by simp
	then show ?thesis
        proof 
	  assume ?write

	  then obtain sop' a'' v' ys zs A' L' R' W' where 
            sb: "sb = ys @ Writesb True a'' sop' v' A' L' R' W' # zs" and
            props: "a  A'" "a  outstanding_refs is_Writesb ys  a''  a"
	    by auto
	  
	  
	  show ?thesis
	  using props False a_notin sb
	    apply -
	    apply (rule disjI1)
	    apply (rule_tac x=sop' in exI)
	    apply (rule_tac x=a'' in exI)	
	    apply (rule_tac x=v' in exI)	
	    apply (rule_tac x="(x#ys)" in exI)	
	    apply (rule_tac x=zs in exI)	
	    apply (simp add: Writesb volatile False a'_a)
	    done
	next
	  assume ?ghst
	  then obtain ys zs A' L' R' W'  where 
            sb: "sb = ys @ Ghostsb A' L' R' W'# zs" and
            props: "a  A'" "a  outstanding_refs is_Writesb ys"
	    by auto
	  
	  
	  show ?thesis
	  using props False a_notin sb
	    apply -
	    apply (rule disjI2)
	    apply (rule_tac x=A' in exI)
	    apply (rule_tac x=L' in exI)	
	    apply (rule_tac x=R' in exI)
	    apply (rule_tac x=W' in exI)	
	    apply (rule_tac x="(x#ys)" in exI)	
	    apply (rule_tac x=zs in exI)	
	    apply (simp add: Writesb volatile False a'_a)
	    done
	qed
      qed
    next
      case False
      from Cons.prems obtain 
	consis': "sharing_consistent 𝒮 𝒪 sb" and
	a_nro': "a  read_only 𝒮" and
	a_unowned: "a  𝒪" and
	a_ro': "a'  𝒪" and
	nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and
	a_unforw': "a  unforwarded_non_volatile_reads sb (insert a' X)"
	by (auto simp add: Writesb False split: if_split_asm)
      
      from unforwarded_not_written [OF a_unforw']
      have a_notin: "a  insert a' X".

      from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_unforw']
      have "(sop a' v ys zs A L R W.
                 sb = ys @ Writesb True a' sop v A L R W # zs 
                 a  A  a  outstanding_refs is_Writesb ys  a'  a) 
              (A L R W ys zs. sb = ys @ Ghostsb A L R W# zs  a  A  a  outstanding_refs is_Writesb ys)"
        (is "?write  ?ghst")
	by simp
	then show ?thesis
        proof 
	  assume ?write

	  then obtain sop' a'' v' ys zs A' L' R' W' where 
            sb: "sb = ys @ Writesb True a'' sop' v' A' L' R' W' # zs" and
            props: "a  A'" "a  outstanding_refs is_Writesb ys  a''  a"
	    by auto
	  
	  
	  show ?thesis
	  using props False a_notin sb
	    apply -
	    apply (rule disjI1)
	    apply (rule_tac x=sop' in exI)
	    apply (rule_tac x=a'' in exI)	
	    apply (rule_tac x=v' in exI)	
	    apply (rule_tac x="(x#ys)" in exI)	
	    apply (rule_tac x=zs in exI)	
	    apply (simp add: Writesb False )
	    done
	next
	  assume ?ghst
	  then obtain ys zs A' L' R' W'  where 
            sb: "sb = ys @ Ghostsb A' L' R' W' # zs" and
            props: "a  A'" "a  outstanding_refs is_Writesb ys"
	    by auto
	  
	  
	  show ?thesis
	  using props False a_notin sb
	    apply -
	    apply (rule disjI2)
	    apply (rule_tac x=A' in exI)
	    apply (rule_tac x=L' in exI)
	    apply (rule_tac x=R' in exI)
	    apply (rule_tac x=W' in exI)
	    apply (rule_tac x="(x#ys)" in exI)	
	    apply (rule_tac x=zs in exI)	
	    apply (simp add: Writesb False )
	    done
	qed
      qed
    next
    case (Readsb volatile a' t v)
    from Cons.prems
    obtain 	
      consis': "sharing_consistent 𝒮 𝒪 sb" and
      a_nro': "a  read_only 𝒮" and
      a_unowned: "a  𝒪" and
      nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and 
      a_unforw: "a  unforwarded_non_volatile_reads sb X"
      by (auto simp add: Readsb split: if_split_asm)
    from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_unforw]
    have "(sop a' v ys zs A L R W.
                 sb = ys @ Writesb True a' sop v A L R W # zs 
                 a  A  a  outstanding_refs is_Writesb ys  a'  a) 
              (A L R W ys zs. sb = ys @ Ghostsb A L R W# zs  a  A  a  outstanding_refs is_Writesb ys)"
      (is "?write  ?ghst")
      by simp
    then show ?thesis
    proof 
      assume ?write

      then obtain sop' a'' v' ys zs A' L' R' W' where 
        sb: "sb = ys @ Writesb True a'' sop' v' A' L' R' W' # zs" and
        props: "a  A'" "a  outstanding_refs is_Writesb ys  a''  a"
        by auto
	  
	  
      show ?thesis
      using props sb
        apply -
	apply (rule disjI1)
	apply (rule_tac x=sop' in exI)
	apply (rule_tac x=a'' in exI)	
	apply (rule_tac x=v' in exI)	
	apply (rule_tac x="(x#ys)" in exI)	
	apply (rule_tac x=zs in exI)	
	apply (simp add: Readsb)
	done
    next
      assume ?ghst
      then obtain ys zs A' L' R' W' where 
        sb: "sb = ys @ Ghostsb A' L' R' W'# zs" and
        props: "a  A'" "a  outstanding_refs is_Writesb ys"
        by auto
	  
	  
      show ?thesis
      using props sb
      apply -
      apply (rule disjI2)
      apply (rule_tac x=A' in exI)
      apply (rule_tac x=L' in exI)	
      apply (rule_tac x=R' in exI)
      apply (rule_tac x=W' in exI)	
      apply (rule_tac x="(x#ys)" in exI)	
      apply (rule_tac x=zs in exI)	
      apply (simp add: Readsb )
      done
    qed
  next
    case Progsb
    from Cons.prems
    obtain 	
      consis': "sharing_consistent 𝒮 𝒪 sb" and
      a_nro': "a  read_only 𝒮" and
      a_unowned: "a  𝒪" and
      nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and 
      a_unforw: "a  unforwarded_non_volatile_reads sb X"
      by (auto simp add: Progsb)
    from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_unforw]
    have "(sop a' v ys zs A L R W.
                 sb = ys @ Writesb True a' sop v A L R W # zs 
                 a  A  a  outstanding_refs is_Writesb ys  a'  a) 
              (A L R W ys zs. sb = ys @ Ghostsb A L R W# zs  a  A  a  outstanding_refs is_Writesb ys)"
      (is "?write  ?ghst")
      by simp
    then show ?thesis
    proof 
      assume ?write

      then obtain sop' a'' v' ys zs A' L' R' W' where 
        sb: "sb = ys @ Writesb True a'' sop' v' A' L' R' W' # zs" and
        props: "a  A'" "a  outstanding_refs is_Writesb ys  a''  a"
        by auto
	  
	  
      show ?thesis
      using props sb
        apply -
	apply (rule disjI1)
	apply (rule_tac x=sop' in exI)
	apply (rule_tac x=a'' in exI)	
	apply (rule_tac x=v' in exI)	
	apply (rule_tac x="(x#ys)" in exI)	
	apply (rule_tac x=zs in exI)	
	apply (simp add: Progsb)
	done
    next
      assume ?ghst
      then obtain ys zs A' L' R' W' where 
        sb: "sb = ys @ Ghostsb A' L' R' W'# zs" and
        props: "a  A'" "a  outstanding_refs is_Writesb ys"
        by auto
	  
	  
      show ?thesis
      using props sb
      apply -
      apply (rule disjI2)
      apply (rule_tac x=A' in exI)
      apply (rule_tac x=L' in exI)	
      apply (rule_tac x=R' in exI)
      apply (rule_tac x=W' in exI)	
      apply (rule_tac x="(x#ys)" in exI)	
      apply (rule_tac x=zs in exI)	
      apply (simp add: Progsb )
      done
    qed
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      nvo': "non_volatile_owned_or_read_only True (𝒮W RA L) (𝒪  A - R) sb" and
      a_nro: "a  read_only 𝒮" and
      a_unowned: "a  𝒪" and
      A_shared_owns: "A  dom 𝒮  𝒪" and L_A: "L  A" and A_R: "A  R = {}" and
      R_owns: "R  𝒪" and
      consis': "sharing_consistent (𝒮W RA L) (𝒪  A - R) sb" and 
      a_unforw: "a  unforwarded_non_volatile_reads sb X"
      by (clarsimp simp add: Ghostsb)

    show ?thesis
    proof (cases "a  A")
      case True
      then show ?thesis
        apply -
	apply (rule disjI2)
	apply (rule_tac x=A in exI)
	apply (rule_tac x=L in exI)	
	apply (rule_tac x=R in exI)
	apply (rule_tac x=W in exI)
	apply (rule_tac x="[]" in exI)	
	apply (rule_tac x=sb in exI)	
	apply (simp add: Ghostsb True)
	done
    next
      case False

      with a_unowned a_nro L_A R_owns a_nro L_A A_R
      obtain a_nro': "a  read_only (𝒮W RA L)" and a_unowned': "a  𝒪  A - R"
	by (force simp add: in_read_only_convs)
      from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_unforw]
      have "(sop a' v ys zs A L R W.
                 sb = ys @ Writesb True a' sop v A L R W # zs 
                 a  A  a  outstanding_refs is_Writesb ys  a'  a) 
              (A L R W ys zs. sb = ys @ Ghostsb A L R W# zs  a  A  a  outstanding_refs is_Writesb ys)"
        (is "?write  ?ghst")
	by simp
      then show ?thesis
      proof 
	assume ?write

	then obtain sop' a'' v' ys zs A' L' R' W' where 
          sb: "sb = ys @ Writesb True a'' sop' v' A' L' R' W' # zs" and
          props: "a  A'" "a  outstanding_refs is_Writesb ys  a''  a"
	  by auto
	  
	  
	show ?thesis
	using props sb
	  apply -
	  apply (rule disjI1)
	  apply (rule_tac x=sop' in exI)
	  apply (rule_tac x=a'' in exI)	
	  apply (rule_tac x=v' in exI)	
	  apply (rule_tac x="(x#ys)" in exI)	
	  apply (rule_tac x=zs in exI)	
	  apply (simp add: Ghostsb False )
	  done
      next
	assume ?ghst
	then obtain ys zs A' L' R' W'  where 
          sb: "sb = ys @ Ghostsb A' L' R' W'# zs" and
          props: "a  A'" "a  outstanding_refs is_Writesb ys"
	  by auto
	  
	  
	show ?thesis
	using props sb
	  apply -
	  apply (rule disjI2)
	  apply (rule_tac x=A' in exI)
	  apply (rule_tac x=L' in exI)	
	  apply (rule_tac x=R' in exI)
	  apply (rule_tac x=W' in exI)	
	  apply (rule_tac x="(x#ys)" in exI)	
	  apply (rule_tac x=zs in exI)	
	  apply (simp add: Ghostsb False )
	  done
	qed
      qed
    qed
  qed (* FIXME: indentation*)

(*
lemma release_take_drop:
"⋀ℛ S. release (dropWhile (Not ∘ is_volatile_Writesb) sb) S (release (takeWhile (Not ∘ is_volatile_Writesb) sb) S ℛ) =
           release sb S ℛ"
apply (induct sb)
apply clarsimp
apply (auto split:memref.splits)
apply fastforce*)

lemma release_shared_exchange_weak: 
assumes shared_eq: "a  𝒪  all_acquired sb. (𝒮'::shared) a = 𝒮 a"
assumes consis: "weak_sharing_consistent 𝒪 sb" 
shows "release sb (dom 𝒮')  = release sb (dom 𝒮) "
using shared_eq consis 
proof (induct sb arbitrary: 𝒮 𝒮' 𝒪 )
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True

      from Cons.prems obtain 
	L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
	consis': "weak_sharing_consistent (𝒪  A - R) sb" and
        shared_eq: "a  𝒪  A  all_acquired sb. 𝒮' a = 𝒮 a"
	by (clarsimp simp add: Writesb True )
      from shared_eq
      have shared_eq': "a𝒪  A - R  all_acquired sb. (𝒮'W RA L) a = (𝒮W RA L) a"
        by (auto simp add: augment_shared_def restrict_shared_def)
      from Cons.hyps [OF shared_eq' consis']
      have "release sb (dom (𝒮'W RA L)) Map.empty = release sb (dom (𝒮W RA L)) Map.empty" .
      then show ?thesis
        by (auto  simp add: Writesb True domIff) 
    next
      case False with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis
      by auto
  next
    case Progsb with Cons show ?thesis
      by auto
  next
    case (Ghostsb A L R W) 
    from Cons.prems obtain 
      L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "weak_sharing_consistent (𝒪  A - R) sb" and
      shared_eq: "a  𝒪  A  all_acquired sb. 𝒮' a = 𝒮 a"
      by (clarsimp simp add: Ghostsb )
    from shared_eq
    have shared_eq': "a𝒪  A - R  all_acquired sb. (𝒮'W RA L) a = (𝒮W RA L) a"
      by (auto simp add: augment_shared_def restrict_shared_def)
    from shared_eq R_owns have "aR. (a  dom 𝒮) = (a  dom 𝒮')"
      by (auto simp add: domIff)
    from augment_rels_shared_exchange [OF this]
    have "(augment_rels (dom 𝒮') R ) = (augment_rels (dom 𝒮) R )".
    
    with Cons.hyps [OF shared_eq' consis']
    have "release sb (dom (𝒮'W RA L)) (augment_rels (dom 𝒮') R ) = 
            release sb (dom (𝒮W RA L)) (augment_rels (dom 𝒮) R )" by simp
    then show ?thesis
      by (clarsimp  simp add: Ghostsb domIff) 
  qed
qed


lemma read_only_share_all_shared: "𝒮.  a  read_only (share sb 𝒮)
 a  read_only 𝒮  all_shared sb"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      with Writesb Cons.hyps [of "(𝒮W RA L)"] Cons.prems
      show ?thesis
        by (auto simp add: read_only_def augment_shared_def restrict_shared_def 
          split: if_split_asm option.splits)
    next
      case False with Writesb Cons show ?thesis by auto
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)
    with Cons.hyps [of "(𝒮W RA L)"] Cons.prems
    show ?thesis
      by (auto simp add: read_only_def augment_shared_def restrict_shared_def 
          split: if_split_asm option.splits)
  qed
qed

lemma read_only_shared_all_until_volatile_write_subset':
"𝒮. 
read_only (share_all_until_volatile_write ts 𝒮)  
  read_only 𝒮  (((λ(_, _, _, sb, _, _ ,_). all_shared (takeWhile (Not  is_volatile_Writesb) sb)) ` set ts))"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  obtain p "is" 𝒪  𝒟 θ sb where
    t: "t = (p,is,θ,sb,𝒟,𝒪,)"
    by (cases t)


  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto


  let ?take_sb = "(takeWhile (Not  is_volatile_Writesb) sb)"
  let ?drop_sb = "(dropWhile (Not  is_volatile_Writesb) sb)"


 
  {
    fix a
    assume a_in: "a  read_only
              (share_all_until_volatile_write ts
                 (share ?take_sb 𝒮))" and
    a_notin_shared: "a  read_only 𝒮" and
    a_notin_rest: "a  (((λ(_, _, _, sb, _, _ ,_). all_shared (takeWhile (Not  is_volatile_Writesb) sb)) ` set ts))"
    have "a  all_shared (takeWhile (Not  is_volatile_Writesb) sb)"
    proof -
      from Cons.hyps [of "(share ?take_sb 𝒮)"] a_in a_notin_rest
      have "a  read_only (share ?take_sb 𝒮)"
        by (auto simp add: aargh)
      from read_only_share_all_shared [OF this] a_notin_shared
      show ?thesis by auto
    qed
  }
      
  then show ?case
    by (auto simp add: t aargh)
qed


lemma read_only_share_acquired_all_shared: 
  "𝒪 𝒮. weak_sharing_consistent 𝒪 sb  𝒪  read_only 𝒮 = {} 
  a  read_only (share sb 𝒮)  a  𝒪  all_acquired sb  a  all_shared sb"
proof (induct sb)
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems obtain
	owns_ro: "𝒪  read_only 𝒮 = {}" and L_A: " L  A" and A_R: "A  R = {}" and
	R_owns: "R  𝒪" and consis': "weak_sharing_consistent  (𝒪  A - R)  sb" and 
        a_share: "a  read_only (share sb (𝒮W RA L))" and
        a_A_all: "a  𝒪  A  all_acquired sb"
	by (clarsimp simp add: Writesb True)

      from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (𝒮W RA L) = {}"
        by (auto simp add: in_read_only_convs)
      from Cons.hyps [OF consis' owns_ro' a_share]
      show ?thesis
      using L_A A_R R_owns owns_ro  a_A_all 
        by (auto simp add: Writesb volatile augment_shared_def restrict_shared_def read_only_def domIff
           split: if_split_asm)
    next 
      case False
      with Cons Writesb show ?thesis by (auto)
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain
      owns_ro: "𝒪  read_only 𝒮 = {}" and L_A: " L  A" and A_R: "A  R = {}" and
      R_owns: "R  𝒪" and consis': "weak_sharing_consistent (𝒪  A - R)  sb" and 
      a_share: "a  read_only (share sb (𝒮W RA L))" and
      a_A_all: "a  𝒪  A  all_acquired sb"
      by (clarsimp simp add: Ghostsb)

    from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (𝒮W RA L) = {}"
      by (auto simp add: in_read_only_convs)
    from Cons.hyps [OF consis' owns_ro' a_share]
    show ?thesis
    using L_A A_R R_owns owns_ro a_A_all 
      by (auto simp add: Ghostsb augment_shared_def restrict_shared_def read_only_def domIff
         split: if_split_asm)
  qed
qed

lemma read_only_share_unowned': "𝒪 𝒮.
  weak_sharing_consistent 𝒪 sb; 𝒪  read_only 𝒮 = {}; a  𝒪  all_acquired sb; a  read_only 𝒮 
   a  read_only (share sb 𝒮)"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case False
      with Cons Writesb show ?thesis by auto
    next
      case True
      from Cons.prems obtain
	owns_ro: "𝒪  read_only 𝒮 = {}" and L_A: " L  A" and A_R: "A  R = {}" and
	R_owns: "R  𝒪" and consis': "weak_sharing_consistent  (𝒪  A - R)  sb" and 
        a_share: "a  read_only 𝒮" and
        a_notin: "a  𝒪" "a  A" "a  all_acquired sb"
	by (clarsimp simp add: Writesb True)
      from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (𝒮W RA L) = {}"
        by (auto simp add: in_read_only_convs)
      from a_notin have a_notin': "a  𝒪  A - R  all_acquired sb"
         by auto
       from a_share  a_notin L_A A_R R_owns  have a_ro': "a  read_only (𝒮W RA L)"
         by (auto simp add: read_only_def restrict_shared_def augment_shared_def)
       from Cons.hyps [OF consis' owns_ro' a_notin' a_ro']
       have "a  read_only (share sb (𝒮W RA L))"
         by auto
       then show ?thesis
         by (auto simp add: Writesb True)
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)
    from Cons.prems obtain
      owns_ro: "𝒪  read_only 𝒮 = {}" and L_A: " L  A" and A_R: "A  R = {}" and
      R_owns: "R  𝒪" and consis': "weak_sharing_consistent  (𝒪  A - R)  sb" and 
      a_share: "a  read_only 𝒮" and
      a_notin: "a  𝒪" "a  A" "a  all_acquired sb"
      by (clarsimp simp add: Ghostsb)
    from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (𝒮W RA L) = {}"
      by (auto simp add: in_read_only_convs)
    from a_notin have a_notin': "a  𝒪  A - R  all_acquired sb"
      by auto
    from a_share  a_notin L_A A_R R_owns  have a_ro': "a  read_only (𝒮W RA L)"
      by (auto simp add: read_only_def restrict_shared_def augment_shared_def)
    from Cons.hyps [OF consis' owns_ro' a_notin' a_ro']
    have "a  read_only (share sb (𝒮W RA L))"
      by auto
    then show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed

(*
lemma release_False_mono:
  "⋀S ℛ. ℛ a = Some False ⟹ release sb S ℛ a = Some False "
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Ghostsb A L R W)
    have rels_a: "ℛ a = Some False" by fact
    then have "(augment_rels S R ℛ) a = Some False"
      by (auto simp add: augment_rels_def)
    from Cons.hyps [where ℛ = "(augment_rels S R ℛ)", OF this]    
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  next
    case Writesb with Cons show ?thesis apply auto
  next 
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  qed
qed
*)


lemma release_False_mono:
  "S .  a = Some False  outstanding_refs is_volatile_Writesb sb = {}  
  release sb S  a = Some False "
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Ghostsb A L R W)
    have rels_a: " a = Some False" by fact
    then have "(augment_rels S R ) a = Some False"
      by (auto simp add: augment_rels_def)
    from Cons.hyps [where= "(augment_rels S R )", OF this] Cons.prems
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  next
    case Writesb with Cons show ?thesis by auto
  next 
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  qed
qed

lemma release_False_mono_take:
  "S .  a = Some False  release (takeWhile (Not  is_volatile_Writesb) sb) S  a = Some False "
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Ghostsb A L R W)
    have rels_a: " a = Some False" by fact
    then have "(augment_rels S R ) a = Some False"
      by (auto simp add: augment_rels_def)
    from Cons.hyps [where= "(augment_rels S R )", OF this]    
    show ?thesis
      by (clarsimp simp add: Ghostsb)
  next
    case Writesb with Cons show ?thesis by auto
  next 
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  qed
qed


lemma shared_switch: 
  "𝒮 𝒪. weak_sharing_consistent 𝒪 sb; read_only 𝒮  𝒪 = {}; 
    𝒮 a  Some False; share sb 𝒮 a = Some False 
   a  𝒪  all_acquired sb "
proof (induct sb)
  case Nil thus ?case by (auto simp add: read_only_def)
next
  case (Cons x sb)
  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto
  show ?case
  proof (cases x)
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      dist: "read_only 𝒮  𝒪 = {}" and
      share: "𝒮 a  Some False" and
      share': "share sb (𝒮W RA L) a = Some False" and
      L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
      consis': "weak_sharing_consistent (𝒪  A - R) sb" by (clarsimp simp add: Ghostsb aargh)
  
    from dist L_A A_R R_owns have dist':  "read_only (𝒮W RA L)  (𝒪  A - R)= {}"
      by (auto simp add: in_read_only_convs)

    show ?thesis
    proof (cases "(𝒮W RA L) a = Some False")
      case False
      from Cons.hyps [OF consis' dist' this share']
      show ?thesis by (auto simp add: Ghostsb)
    next
      case True
      with share L_A A_R R_owns dist
      have "a  𝒪  A"
        by (cases "𝒮 a")      
           (auto simp add: augment_shared_def restrict_shared_def read_only_def split: if_split_asm )
      thus ?thesis by (auto simp add: Ghostsb)
   qed
 next
   case (Writesb volatile a' sop v A L R W)
   show ?thesis
   proof (cases volatile)
     case True
     note volatile=this
     from Cons.prems obtain 
       dist: "read_only 𝒮  𝒪 = {}" and
       share: "𝒮 a  Some False" and
       share': "share sb (𝒮W RA L) a = Some False" and
       L_A: "L  A" and A_R: "A  R = {}" and R_owns: "R  𝒪" and
       consis': "weak_sharing_consistent (𝒪  A - R) sb" by (clarsimp simp add: Writesb True aargh)
  
     from dist L_A A_R R_owns have dist':  "read_only (𝒮W RA L)  (𝒪  A - R)= {}"
       by (auto simp add: in_read_only_convs)

     show ?thesis
     proof (cases "(𝒮W RA L) a = Some False")
       case False
       from Cons.hyps [OF consis' dist' this share']
       show ?thesis by (auto simp add: Writesb True)
     next
       case True
       with share L_A A_R R_owns dist
       have "a  𝒪  A"
         by (cases "𝒮 a")      
           (auto simp add: augment_shared_def restrict_shared_def read_only_def split: if_split_asm )
       thus ?thesis by (auto simp add: Writesb volatile)
     qed 
   next
     case False
     with Cons show ?thesis by (auto simp add: Writesb)
   qed
 next
   case Readsb with Cons show ?thesis by (auto)
 next
   case Progsb with Cons show ?thesis by (auto)
 qed
qed

lemma shared_switch_release_False: 
  "𝒮 . 
     outstanding_refs is_volatile_Writesb sb = {};
     a  dom 𝒮; 
     a  dom (share sb 𝒮)
   
      release sb (dom 𝒮)  a =  Some False" 
proof (induct sb)
  case Nil thus ?case by (auto simp add: read_only_def)
next
  case (Cons x sb)
  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto
  show ?case
  proof (cases x)
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      a_notin: "a  dom 𝒮" and
      share: "a  dom (share sb (𝒮W RA L))" and
      out': "outstanding_refs is_volatile_Writesb sb = {}"
      by (clarsimp simp add: Ghostsb aargh)
  
    show ?thesis
    proof (cases "a  R")
      case False
      with a_notin have "a  dom (𝒮W RA L)"
        by auto
      from Cons.hyps [OF out' this share]
      show ?thesis
        by (auto simp add: Ghostsb)
    next
      case True
      with a_notin have "augment_rels (dom 𝒮) R  a = Some False"
        by (auto simp add: augment_rels_def split: option.splits)
      from release_False_mono [of "augment_rels (dom 𝒮) R ", OF this out'] 
      show ?thesis
        by (auto simp add: Ghostsb)
    qed
  next
    case Writesb with Cons show ?thesis by (clarsimp split: if_split_asm)
  next
    case Readsb with Cons show ?thesis by auto
  next 
    case Progsb with Cons show ?thesis by auto
  qed 
qed


lemma release_not_unshared_no_write:  
  "𝒮 . 
     outstanding_refs is_volatile_Writesb sb = {};     
  non_volatile_writes_unshared 𝒮 sb;
  release sb (dom 𝒮)  a   Some False;
  a  dom (share sb 𝒮)
   
    a  outstanding_refs is_non_volatile_Writesb sb" 
proof (induct sb)
  case Nil thus ?case by (auto simp add: read_only_def)
next
  case (Cons x sb)
  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto
  show ?case
  proof (cases x)
    case (Ghostsb A L R W)
    from Cons.prems obtain 
      share: "a  dom (share sb (𝒮W RA L))" and
      rel: "release sb 
                (dom (𝒮W RA L)) (augment_rels (dom 𝒮) R ) a   Some False" and
      out': "outstanding_refs is_volatile_Writesb sb = {}" and
      nvu: "non_volatile_writes_unshared (𝒮W RA L) sb" 
      by (clarsimp simp add: Ghostsb )
  
    
    from Cons.hyps [OF out' nvu rel share]
    show ?thesis by (auto simp add: Ghostsb)
  next
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True with Writesb Cons.prems have False by auto
      thus ?thesis ..
    next
      case False
      note not_vol = this
      from Cons.prems obtain 
        rel: "release sb (dom 𝒮)  a   Some False" and
        out': "outstanding_refs is_volatile_Writesb sb = {}" and
        nvo: "non_volatile_writes_unshared 𝒮 sb" and
        a'_not_dom: "a'  dom 𝒮" and
        a_dom: "a  dom (share sb 𝒮)"
        by (auto simp add: Writesb False)
      from Cons.hyps [OF out' nvo rel a_dom]
      have a_notin_rest: "a  outstanding_refs is_non_volatile_Writesb sb".
      
      show ?thesis
      proof (cases "a'=a")
        case False with a_notin_rest
        show ?thesis by (clarsimp simp add: Writesb  not_vol )
      next
        case True
        from shared_switch_release_False [OF out' a'_not_dom [simplified True] a_dom]
        have "release sb (dom 𝒮)  a =  Some False".
        with rel have False by simp
        thus ?thesis ..
      qed
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next 
    case Progsb with Cons show ?thesis by auto
  qed 
qed

corollary release_not_unshared_no_write_take:  
 assumes nvw: "non_volatile_writes_unshared 𝒮 (takeWhile (Not  is_volatile_Writesb) sb)"
 assumes rel: "release (takeWhile (Not  is_volatile_Writesb) sb) (dom 𝒮)  a   Some False"
 assumes a_in: "a  dom (share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮)"
 shows
    "a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sb)" 
using release_not_unshared_no_write[OF takeWhile_not_vol_write_outstanding_refs [of sb] nvw rel a_in]
by simp

(* FIXME: may replace the un-primed variants, similar for the following lemmas *)
lemma read_only_unacquired_share':
  "S 𝒪. 𝒪  read_only S = {}; weak_sharing_consistent 𝒪 sb; a  read_only S; 
  a  all_shared sb; a  acquired True sb 𝒪 
 a  read_only (share sb S)"
proof (induct sb)
    case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems
      obtain a_ro: "a  read_only S" and a_R: "a  R" and a_unsh: "a  all_shared sb" and 
	owns_ro: "𝒪  read_only S = {}" and 
	L_A: "L  A" and A_R:  "A  R = {}" and R_owns: "R  𝒪" and
	consis': "weak_sharing_consistent (𝒪  A - R) sb" and
        a_notin: "a  acquired True sb (𝒪  A - R)" 
	by (clarsimp simp add: Writesb True)
      show ?thesis
      proof (cases "a  A")
        case True
        with a_R have "a  𝒪  A - R" by auto
        from all_shared_acquired_in [OF this a_unsh]
        have "a   acquired True sb (𝒪  A - R)" by auto
        with a_notin have False by auto
        thus ?thesis ..
      next
        case False
        
        from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (SW RA L) = {}"
	  by (auto simp add: in_read_only_convs)

        from a_ro False owns_ro R_owns L_A have a_ro': "a  read_only (SW RA L)"
	  by (auto simp add: in_read_only_convs)
        from Cons.hyps [OF owns_ro' consis' a_ro' a_unsh a_notin]
        show ?thesis
	  by (clarsimp simp add: Writesb True)
      qed
   next
      case False
      with Cons show ?thesis
	by (clarsimp simp add: Writesb False)
    qed
  next
    case Readsb with Cons show ?thesis by (clarsimp)
  next
    case Progsb with Cons show ?thesis by (clarsimp)
  next
    case (Ghostsb A L R W)
    from Cons.prems
    obtain a_ro: "a  read_only S" and a_R: "a  R" and a_unsh: "a  all_shared sb" and 
      owns_ro: "𝒪  read_only S = {}" and 
      L_A: "L  A" and A_R:  "A  R = {}" and R_owns: "R  𝒪" and
      consis': "weak_sharing_consistent (𝒪  A - R) sb" and
      a_notin: "a  acquired True sb (𝒪  A - R)" 
      by (clarsimp simp add: Ghostsb)
    show ?thesis
    proof (cases "a  A")
      case True
      with a_R have "a  𝒪  A - R" by auto
      from all_shared_acquired_in [OF this a_unsh]
      have "a   acquired True sb (𝒪  A - R)" by auto
      with a_notin have False by auto
      thus ?thesis ..
    next
      case False
      
      from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (SW RA L) = {}"
        by (auto simp add: in_read_only_convs)

      from a_ro False owns_ro R_owns L_A have a_ro': "a  read_only (SW RA L)"
        by (auto simp add: in_read_only_convs)
      from Cons.hyps [OF owns_ro' consis' a_ro' a_unsh a_notin]
      show ?thesis
        by (clarsimp simp add: Ghostsb)
    qed
  qed
qed

lemma read_only_share_all_until_volatile_write_unacquired':
  "𝒮. ownership_distinct ts; read_only_unowned 𝒮 ts; weak_sharing_consis ts; 
  i < length ts. (let (_,_,_,sb,_,𝒪,) = ts!i in 
            a  acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪 
            a  all_shared (takeWhile (Not  is_volatile_Writesb) sb
     )); 
  a  read_only 𝒮 
   a  read_only (share_all_until_volatile_write ts 𝒮)"
proof (induct ts)
  case Nil thus ?case by simp
next
  case (Cons t ts)
  obtain p "is" 𝒪  𝒟 θ sb where
    t: "t = (p,is,θ,sb,𝒟,𝒪,)"
    by (cases t)

  have dist: "ownership_distinct (t#ts)" by fact
  then interpret ownership_distinct "t#ts" .
  from ownership_distinct_tl [OF dist]
  have dist': "ownership_distinct ts".


  have aargh: "(Not  is_volatile_Writesb) = (λa. ¬ is_volatile_Writesb a)"
    by (rule ext) auto

  have a_ro: "a  read_only 𝒮" by fact
  have ro_unowned: "read_only_unowned 𝒮 (t#ts)" by fact
  then interpret read_only_unowned 𝒮 "t#ts" .
  have consis: "weak_sharing_consis (t#ts)" by fact
  then interpret weak_sharing_consis "t#ts" .

  note consis' = weak_sharing_consis_tl [OF consis]

  let ?take_sb = "(takeWhile (Not  is_volatile_Writesb) sb)"
  let ?drop_sb = "(dropWhile (Not  is_volatile_Writesb) sb)"

  from weak_sharing_consis [of 0] t
  have consis_sb: "weak_sharing_consistent 𝒪 sb"
    by force
  with weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
  have consis_take: "weak_sharing_consistent 𝒪 ?take_sb"
    by auto


  have ro_unowned': "read_only_unowned (share ?take_sb 𝒮) ts"
  proof 
    fix j
    fix pj isj 𝒪j j 𝒟j θj sbj
    assume j_bound: "j < length ts"
    assume jth: "ts!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
    show "𝒪j  read_only (share ?take_sb 𝒮) = {}"
    proof -
      {
        fix a
        assume a_owns: "a  𝒪j" 
        assume a_ro: "a  read_only (share ?take_sb 𝒮)"
        have False
        proof -
          from ownership_distinct [of 0 "Suc j"] j_bound jth t
          have dist: "(𝒪  all_acquired sb)  (𝒪j  all_acquired sbj) = {}"
            by fastforce
    
          from read_only_unowned [of "Suc j"] j_bound jth
          have dist_ro: "𝒪j  read_only 𝒮 = {}" by force
          show ?thesis
          proof (cases "a  (𝒪  all_acquired sb)")
            case True
            with dist a_owns show False by auto
          next
            case False
            hence "a   (𝒪  all_acquired ?take_sb)"
            using all_acquired_append [of ?take_sb ?drop_sb]
              by auto
            from read_only_share_unowned [OF consis_take this a_ro]
            have "a  read_only 𝒮".
            with dist_ro a_owns show False by auto
         qed
       qed
      }
      thus ?thesis by auto
    qed
  qed

      
  from Cons.prems
  obtain unacq_ts: "i < length ts. (let (_,_,_,sb,_,𝒪,_) = ts!i in 
           a  acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪 
            a  all_shared (takeWhile (Not  is_volatile_Writesb) sb)) " and
    unacq_sb: "a  acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪" and
    unsh_sb: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sb) "

   apply clarsimp
   apply (rule that)
   apply (auto simp add: t aargh)
   done

  
  from read_only_unowned [of 0] t
  have owns_ro: "𝒪  read_only 𝒮 = {}"
    by force


  from read_only_unacquired_share' [OF owns_ro consis_take a_ro unsh_sb unacq_sb]
  have "a  read_only (share (takeWhile (Not  is_volatile_Writesb) sb) 𝒮)".
  from Cons.hyps [OF dist' ro_unowned' consis' unacq_ts this]
  show ?case
    by (simp add: t)
qed


  

lemma not_shared_not_acquired_switch:
  "X Y. a  all_shared sb; a  X; a  acquired True sb X; a  Y   a  acquired True sb Y"
proof (induct sb)
  case Nil thus ?case by simp
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      from Cons.prems obtain 
        a_X: "a  X"  and a_acq: "a  acquired True sb (X  A - R)" and 
        a_Y: "a  Y" and a_R: "a  R" and 
        a_shared: "a  all_shared sb"
        by (clarsimp simp add: Writesb True)
      show ?thesis
      proof (cases "a  A")
        case True
        with a_X a_R 
        have "a  X  A - R" by auto
        from all_shared_acquired_in [OF this a_shared]
        have "a  acquired True sb (X  A - R)".
        with a_acq have False by simp 
        thus ?thesis ..
     next
       case False
       with a_X a_Y obtain a_X': "a  X  A - R" and a_Y': "a  Y  A - R"
         by auto
       from Cons.hyps [OF a_shared a_X' a_acq a_Y']
       show ?thesis
         by (auto simp add: Writesb True)
     qed
   next
     case False with Cons.hyps [of X Y] Cons.prems show ?thesis by (auto simp add: Writesb)
   qed
 next
   case Readsb with Cons.hyps [of X Y] Cons.prems show ?thesis by (auto)
 next
   case Progsb with Cons.hyps [of X Y] Cons.prems show ?thesis by (auto)
 next
   case (Ghostsb A L R W)
   from Cons.prems obtain 
     a_X: "a  X"  and a_acq: "a  acquired True sb (X  A - R)" and 
     a_Y: "a  Y" and a_R: "a  R" and 
     a_shared: "a  all_shared sb"
     by (clarsimp simp add: Ghostsb)
   show ?thesis
   proof (cases "a  A")
     case True
     with a_X a_R 
     have "a  X  A - R" by auto
     from all_shared_acquired_in [OF this a_shared]
     have "a  acquired True sb (X  A - R)".
     with a_acq have False by simp 
     thus ?thesis ..
   next
     case False
     with a_X a_Y obtain a_X': "a  X  A - R" and a_Y': "a  Y  A - R"
       by auto
     from Cons.hyps [OF a_shared a_X' a_acq a_Y']
     show ?thesis
       by (auto simp add: Ghostsb)
   qed
 qed
qed

(* FIXME: could be strengthened to acquired True sb empty I suppose *)
lemma read_only_share_all_acquired_in': 
  "S 𝒪. 𝒪  read_only S = {}; weak_sharing_consistent 𝒪 sb; a  read_only (share sb S) 
   a  read_only (share sb Map.empty)  (a  read_only S  a  acquired True sb 𝒪  a  all_shared sb )"
proof (induct sb)
    case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.prems
      obtain a_in: "a  read_only (share sb (SW RA L))" and
	owns_ro: "𝒪  read_only S = {}" and 
	L_A: "L  A" and A_R:  "A  R = {}" and R_owns: "R  𝒪" and
	consis': "weak_sharing_consistent (𝒪  A - R) sb"
	by (clarsimp simp add: Writesb True)

      from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (SW RA L) = {}"
	by (auto simp add: in_read_only_convs)

      from Cons.hyps [OF owns_ro' consis' a_in]
      have hyp: "a  read_only (share sb Map.empty)  
                 (a  read_only (SW RA L)  a  acquired True sb (𝒪  A - R)  a  all_shared sb)".

      have "a  read_only (share sb (Map.empty ⊕W RA L))  
           (a  read_only S  a  R  a  acquired True sb (𝒪  A - R)  a  all_shared sb)"
      proof -
	{
	  assume a_emp: "a  read_only (share sb Map.empty)"
	  have "read_only Map.empty  read_only (Map.empty ⊕W RA L)"
	    by (auto simp add: in_read_only_convs)
	  
	  from share_read_only_mono_in [OF a_emp this]
	  have "a  read_only (share sb (Map.empty ⊕W RA L))".
	}
	moreover
	{
	  assume a_ro: "a  read_only (SW RA L)" and
            a_not_acq: "a  acquired True sb (𝒪  A - R)" and  
            a_unsh: "a  all_shared sb" 
          have ?thesis
	  proof (cases "a  read_only S")
	    case True
	    with a_ro obtain a_A: "a  A"
	      by (auto simp add: in_read_only_convs)
            with True a_not_acq a_unsh R_owns owns_ro
            show ?thesis
               by auto
          next
            case False
	    with a_ro have a_ro_empty: "a  read_only (Map.empty ⊕W RA L)"
	      by (auto simp add: in_read_only_convs split: if_split_asm)
	    
	    have "read_only (Map.empty ⊕W RA L)  read_only (SW RA L)"
	      by (auto simp add: in_read_only_convs)
	    with owns_ro'
	    have owns_ro_empty: "(𝒪  A - R)  read_only (Map.empty ⊕W RA L) = {}"
	      by blast


	    from read_only_unacquired_share' [OF owns_ro_empty consis' a_ro_empty a_unsh a_not_acq]
	    have "a  read_only (share sb (Map.empty ⊕W RA L))".
	    thus ?thesis
	      by simp
	  qed
	}
	moreover note hyp
	ultimately show ?thesis by blast
      qed

      then show ?thesis
	by (clarsimp simp add: Writesb True)
    next
      case False with Cons show ?thesis
	by (auto simp add: Writesb)
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)
    from Cons.prems
    obtain a_in: "a  read_only (share sb (SW RA L))" and
      owns_ro: "𝒪  read_only S = {}" and 
      L_A: "L  A" and A_R:  "A  R = {}" and R_owns: "R  𝒪" and
      consis': "weak_sharing_consistent (𝒪  A - R) sb"
      by (clarsimp simp add: Ghostsb)
    
    from owns_ro A_R R_owns have owns_ro': "(𝒪  A - R)  read_only (SW RA L) = {}"
      by (auto simp add: in_read_only_convs)

    from Cons.hyps [OF owns_ro' consis' a_in]
    have hyp: "a  read_only (share sb Map.empty)  
                 (a  read_only (SW RA L)  a  acquired True sb (𝒪  A - R)  a  all_shared sb)".

    have "a  read_only (share sb (Map.empty ⊕W RA L))  
           (a  read_only S  a  R  a  acquired True sb (𝒪  A - R)  a  all_shared sb)"
    proof -
      {
	assume a_emp: "a  read_only (share sb Map.empty)"
	have "read_only Map.empty  read_only (Map.empty ⊕W RA L)"
	  by (auto simp add: in_read_only_convs)
	  
	from share_read_only_mono_in [OF a_emp this]
	have "a  read_only (share sb (Map.empty ⊕W RA L))".
      }
      moreover
      {
	assume a_ro: "a  read_only (SW RA L)" and
          a_not_acq: "a  acquired True sb (𝒪  A - R)" and  
          a_unsh: "a  all_shared sb" 
        have ?thesis
        proof (cases "a  read_only S")
	  case True
	  with a_ro obtain a_A: "a  A"
	    by (auto simp add: in_read_only_convs)
          with True a_not_acq a_unsh R_owns owns_ro
          show ?thesis
            by auto
        next
          case False
	  with a_ro have a_ro_empty: "a  read_only (Map.empty ⊕W RA L)"
	    by (auto simp add: in_read_only_convs split: if_split_asm)
	    
	  have "read_only (Map.empty ⊕W RA L)  read_only (SW RA L)"
	    by (auto simp add: in_read_only_convs)
	  with owns_ro'
	  have owns_ro_empty: "(𝒪  A - R)  read_only (Map.empty ⊕W RA L) = {}"
	    by blast


	  from read_only_unacquired_share' [OF owns_ro_empty consis' a_ro_empty a_unsh a_not_acq]
	  have "a  read_only (share sb (Map.empty ⊕W RA L))".
	  thus ?thesis
	    by simp
	qed
      }
      moreover note hyp
      ultimately show ?thesis by blast
    qed
    
    then show ?thesis
      by (clarsimp simp add: Ghostsb)
  qed
qed

lemma in_read_only_share_all_until_volatile_write':
  assumes dist: "ownership_distinct ts"
  assumes consis: "sharing_consis 𝒮 ts"
  assumes ro_unowned: "read_only_unowned 𝒮 ts"
  assumes i_bound: "i < length ts"
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)"
  assumes a_unacquired_others: "j < length ts. ij  
            (let (_,_,_,sbj,_,𝒪,_) = ts!j in
            a  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪 
            a  all_shared (takeWhile (Not  is_volatile_Writesb) sbj ))"
  assumes a_ro_share: "a  read_only (share sb 𝒮)"
  shows "a  read_only (share (dropWhile (Not  is_volatile_Writesb) sb) 
                    (share_all_until_volatile_write ts 𝒮))"
proof -
  from consis
  interpret sharing_consis 𝒮 ts .
  interpret read_only_unowned 𝒮 ts by fact

  from sharing_consis [OF i_bound ts_i]
  have consis_sb: "sharing_consistent 𝒮 𝒪 sb".
  from sharing_consistent_weak_sharing_consistent [OF this] 
  have weak_consis: "weak_sharing_consistent 𝒪 sb".
  from read_only_unowned [OF i_bound ts_i]
  have owns_ro: "𝒪  read_only 𝒮 = {}".
  from read_only_share_all_acquired_in' [OF owns_ro weak_consis a_ro_share]
  (* make similar version with acquired and all_shared instead of all_acquired *)
  have "a  read_only (share sb Map.empty)  a  read_only 𝒮  a  acquired True sb 𝒪  a  all_shared sb".
  moreover
  
  let ?take_sb = "(takeWhile (Not  is_volatile_Writesb) sb)"
  let ?drop_sb = "(dropWhile (Not  is_volatile_Writesb) sb)"

  from weak_consis weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
  obtain weak_consis': "weak_sharing_consistent (acquired True ?take_sb 𝒪) ?drop_sb" and
    weak_consis_take: "weak_sharing_consistent 𝒪 ?take_sb" 
    by auto
  
  {
    assume "a  read_only (share sb Map.empty)"
    with share_append [of ?take_sb ?drop_sb]
    have a_in': "a  read_only (share ?drop_sb (share ?take_sb Map.empty))"
      by auto

    have owns_empty: "𝒪  read_only Map.empty = {}"
      by auto

    from weak_sharing_consistent_preserves_distinct [OF weak_consis_take owns_empty]
    have "acquired True ?take_sb 𝒪  read_only (share ?take_sb Map.empty) = {}".

    from read_only_share_all_acquired_in [OF this weak_consis' a_in']
    have "a  read_only (share ?drop_sb Map.empty)  a  read_only (share ?take_sb Map.empty)  a  all_acquired ?drop_sb".
    moreover
    {
      assume a_ro_drop: "a  read_only (share ?drop_sb Map.empty)"
      have "read_only Map.empty  read_only (share_all_until_volatile_write ts 𝒮)"
	by auto
      from share_read_only_mono_in [OF a_ro_drop this]
      have ?thesis .
    }
    moreover
    {
      assume a_ro_take: "a  read_only (share ?take_sb Map.empty)" 
      assume a_unacq_drop: "a  all_acquired ?drop_sb"
      from read_only_share_unowned_in [OF weak_consis_take a_ro_take] 
      have "a  𝒪  all_acquired ?take_sb" by auto
      hence "a  𝒪  all_acquired sb" using all_acquired_append [of ?take_sb ?drop_sb]
        by auto
      from  share_all_until_volatile_write_thread_local' [OF dist consis i_bound ts_i this] a_ro_share
      have ?thesis by (auto simp add: read_only_def)
    }
    ultimately have ?thesis by blast
  }

  moreover

  {
    assume a_ro: "a  read_only 𝒮" 
    assume a_unacq: "a  acquired True sb 𝒪"
    assume a_unsh: "a  all_shared sb"
    with all_shared_append [of ?take_sb ?drop_sb]
    obtain a_notin_take: "a  all_shared ?take_sb" and a_notin_drop: "a  all_shared ?drop_sb"
      by auto
    have ?thesis
    proof (cases "a  acquired True ?take_sb 𝒪")
      case True
      from all_shared_acquired_in [OF this a_notin_drop] acquired_append [of True ?take_sb ?drop_sb 𝒪] a_unacq
      have False
        by auto
      thus ?thesis ..
    next
      case False
      with a_unacquired_others i_bound ts_i a_notin_take
      have a_unacq': "j < length ts.  
            (let (_,_,_,sbj,_,𝒪,_) = ts!j in
            a  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪 
            a  all_shared (takeWhile (Not  is_volatile_Writesb) sbj ))"
        by (auto simp add: Let_def)

      from local.weak_sharing_consis_axioms have "weak_sharing_consis ts" .
      from read_only_share_all_until_volatile_write_unacquired' [OF dist ro_unowned 
       ‹weak_sharing_consis ts a_unacq' a_ro] 
      have a_ro_all: "a  read_only (share_all_until_volatile_write ts 𝒮)" .

      from weak_consis weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
      have weak_consis_drop: "weak_sharing_consistent (acquired True ?take_sb 𝒪) ?drop_sb"
        by auto

      from weak_sharing_consistent_preserves_distinct_share_all_until_volatile_write [OF dist 
        ro_unowned ‹weak_sharing_consis ts i_bound ts_i]
      have "acquired True ?take_sb 𝒪 
         read_only (share_all_until_volatile_write ts 𝒮) = {}".

      from read_only_unacquired_share' [OF this weak_consis_drop a_ro_all a_notin_drop]
        acquired_append [of True ?take_sb ?drop_sb 𝒪] a_unacq
      show ?thesis by auto
    qed
  }
  ultimately show ?thesis by blast
qed

lemma all_acquired_unshared_acquired:
  "𝒪. a  all_acquired sb ==> a  all_shared sb ==> a  acquired True sb 𝒪"
apply (induct sb)
apply (auto split: memref.split intro: all_shared_acquired_in)
done




lemma  safe_RMW_common:
  assumes safe: "𝒪s,ℛs,i (RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"
  shows "(a  𝒪  a  dom 𝒮)  (j < length 𝒪s. ij  (ℛs!j) a  Some False)"
using safe 
apply (cases)
apply (auto simp add: domIff)
done


lemma acquired_reads_all_acquired': "𝒪.
  acquired_reads True sb 𝒪  acquired True sb 𝒪  all_shared sb"
apply (induct sb)
apply  clarsimp
apply (auto split: memref.splits dest: all_shared_acquired_in)
done


lemma release_all_shared_exchange: 
  " S' S. a  all_shared sb. (a  S') = (a  S)  release sb S'  = release sb S "
proof (induct sb)
  case Nil thus ?case by auto
next
  case (Cons x sb)
  show ?case
  proof (cases x)
    case (Writesb volatile a' sop v A L R W)
    show ?thesis
    proof (cases volatile)
      case True
      note volatile=this
      from Cons.hyps [of "(S'  R - L)" "(S  R - L)" Map.empty] Cons.prems
      show ?thesis
        by (auto simp add: Writesb volatile)
    next
      case False with Cons Writesb show ?thesis by auto
    qed
  next
    case Readsb with Cons show ?thesis by auto
  next
    case Progsb with Cons show ?thesis by auto
  next
    case (Ghostsb A L R W)  
    from augment_rels_shared_exchange [of R S S' ] Cons.prems
    have "augment_rels S' R  = augment_rels S R "
      by (auto simp add: Ghostsb)

    with Cons.hyps [of "(S'  R - L)" "(S  R - L)" "augment_rels S R "] Cons.prems
    show ?thesis
      by (auto simp add: Ghostsb)
  qed
qed

lemma release_append_Progsb:
"S . (release (takeWhile (Not  is_volatile_Writesb) (sb @ [Progsb p1 p2 mis])) S ) = 
       (release  (takeWhile (Not  is_volatile_Writesb) sb) S ) "
  by (induct sb) (auto split: memref.splits)

subsection ‹Simulation of Store Buffer Machine with History by Virtual Machine with Delayed Releases›

theorem (in xvalid_program) concurrent_direct_steps_simulates_store_buffer_history_step:
  assumes step_sb: "(tssb,msb,𝒮sb) sbh (tssb',msb',𝒮sb')"
  assumes valid_own: "valid_ownership 𝒮sb tssb"
  assumes valid_sb_reads: "valid_reads msb tssb"
  assumes valid_hist: "valid_history program_step tssb"
  assumes valid_sharing: "valid_sharing 𝒮sb tssb"
  assumes tmps_distinct: "tmps_distinct tssb"
  assumes valid_sops: "valid_sops tssb"
  assumes valid_dd: "valid_data_dependency tssb"
  assumes load_tmps_fresh: "load_tmps_fresh tssb"
  assumes enough_flushs: "enough_flushs tssb"
  assumes valid_program_history: "valid_program_history tssb"
  assumes valid: "valid tssb"
  assumes sim: "(tssb,msb,𝒮sb)  (ts,m,𝒮)"
  assumes safe_reach: "safe_reach_direct safe_delayed (ts,m,𝒮)"
  shows "valid_ownership 𝒮sb' tssb'  valid_reads msb' tssb'  valid_history program_step tssb' 
         valid_sharing 𝒮sb' tssb'  tmps_distinct tssb'  valid_data_dependency tssb' 
         valid_sops tssb'  load_tmps_fresh tssb'  enough_flushs tssb' 
         valid_program_history tssb'  valid tssb' 
           (ts' 𝒮' m'. (ts,m,𝒮) d* (ts',m',𝒮')  
                     (tssb',msb',𝒮sb')  (ts',m',𝒮'))"
  
proof -

  interpret direct_computation:
    computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
  interpret sbh_computation: 
    computation sbh_memop_step flush_step program_step 
       "λp p' is sb. sb @ [Progsb p p' is]" .
  interpret valid_ownership 𝒮sb tssb by fact
  interpret valid_reads msb tssb by fact
  interpret valid_history program_step tssb by fact
  interpret valid_sharing 𝒮sb tssb by fact
  interpret tmps_distinct tssb by fact
  interpret valid_sops tssb by fact
  interpret valid_data_dependency tssb by fact
  interpret load_tmps_fresh tssb by fact
  interpret enough_flushs tssb by fact
  interpret valid_program_history tssb by fact
  from valid_own valid_sharing
  have valid_own_sharing: "valid_ownership_and_sharing 𝒮sb tssb"
    by (simp add: valid_sharing_def valid_ownership_and_sharing_def)
  then
  interpret valid_ownership_and_sharing 𝒮sb tssb .

  from safe_reach_safe_refl [OF safe_reach]
  have safe: "safe_delayed (ts,m,𝒮)".

  from step_sb
  show ?thesis
  proof (cases)
    case (Memop i psb "issb" θsb sb  𝒟sb 𝒪sb sb  "issb'" θsb' sb'  𝒟sb' 𝒪sb' sb')
    then obtain 
      tssb': "tssb' = tssb[i := (psb, issb',θsb', sb', 𝒟sb', 𝒪sb',sb')]" and
      i_bound: "i < length tssb" and
      tssb_i: "tssb ! i = (psb, issb,θsb,sb, 𝒟sb, 𝒪sb,sb)" and
      sbh_step: "(issb, θsb, sb, msb, 𝒟sb, 𝒪sb, sb,𝒮sb) sbh 
                  (issb', θsb', sb', msb', 𝒟sb', 𝒪sb', sb', 𝒮sb')"
      by auto

    from sim obtain 
      m: "m = flush_all_until_volatile_write tssb msb" and
      𝒮: "𝒮 = share_all_until_volatile_write tssb 𝒮sb" and
      leq: "length tssb = length ts" and
      ts_sim: "i<length tssb.
           let (p, issb, θ, sb, 𝒟sb, 𝒪sb,) = tssb ! i;
               suspends = dropWhile (Not  is_volatile_Writesb) sb
           in  is 𝒟. instrs suspends @ issb = is @ prog_instrs suspends 
                    𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb sb  {}) 
                    ts ! i =
                   (hd_prog p suspends, 
                    is,
                    θ |` (dom θ - read_tmps suspends), (),
                    𝒟, 
                    acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪sb,
                    release (takeWhile (Not  is_volatile_Writesb) sb) (dom 𝒮sb) )"
      by cases blast

    from i_bound leq have i_bound': "i < length ts"
      by auto

    have split_sb: "sb = takeWhile (Not  is_volatile_Writesb) sb @ dropWhile (Not  is_volatile_Writesb) sb"
      (is "sb = ?take_sb@?drop_sb")
      by simp

    from ts_sim [rule_format, OF i_bound] tssb_i obtain suspends "is" 𝒟 where
      suspends: "suspends = dropWhile (Not  is_volatile_Writesb) sb" and
      is_sim: "instrs suspends @ issb = is @ prog_instrs suspends" and
      𝒟: "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb sb  {})" and
      ts_i: "ts ! i =
          (hd_prog psb suspends, is,
           θsb |` (dom θsb - read_tmps suspends), (), 𝒟, acquired True ?take_sb 𝒪sb,
            release ?take_sb (dom 𝒮sb) sb)"
      by (auto simp add: Let_def)

    from sbh_step_preserves_valid [OF i_bound tssb_i sbh_step valid]
    have valid': "valid tssb'"
      by (simp add: tssb')
    

    from 𝒟 have 𝒟sb: "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb ?drop_sb  {})"
      apply -
      apply (case_tac "outstanding_refs is_volatile_Writesb sb = {}")
      apply  (fastforce simp add: outstanding_refs_conv dest: set_dropWhileD)
      apply (clarsimp)
      apply (drule outstanding_refs_non_empty_dropWhile)
      apply blast
      done

    let ?ts' = "ts[i := (psb, issb, θsb, (), 𝒟sb, acquired True sb 𝒪sb,
                         release sb (dom 𝒮sb) sb)]"
    have i_bound_ts': "i < length ?ts'"
      using i_bound'
      by auto
    hence ts'_i: "?ts'!i = (psb, issb, θsb, (), 
                     𝒟sb, acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb)"
      by simp 

    from local.sharing_consis_axioms
    have sharing_consis_tssb: "sharing_consis 𝒮sb tssb" .
    from sharing_consis [OF i_bound tssb_i]
    have sharing_consis_sb: "sharing_consistent 𝒮sb 𝒪sb sb".
    from sharing_consistent_weak_sharing_consistent [OF this]
    have weak_consis_sb: "weak_sharing_consistent 𝒪sb sb".
    from this weak_sharing_consistent_append [of 𝒪sb ?take_sb ?drop_sb]
    have weak_consis_drop:"weak_sharing_consistent (acquired True ?take_sb 𝒪sb) ?drop_sb"
      by auto
    from local.ownership_distinct_axioms
    have ownership_distinct_tssb: "ownership_distinct tssb" .
    have steps_flush_sb: "(ts,m,𝒮) d* (?ts', flush ?drop_sb m, share ?drop_sb 𝒮)"
    proof -
      from valid_reads [OF i_bound tssb_i]
      have reads_consis: "reads_consistent False 𝒪sb msb sb".
      from reads_consistent_drop_volatile_writes_no_volatile_reads [OF this]
      have no_vol_read: "outstanding_refs is_volatile_Readsb ?drop_sb = {}".
      from valid_program_history [OF i_bound tssb_i]
      have "causal_program_history issb sb".
      then have cph: "causal_program_history issb ?drop_sb"
	apply -
	apply (rule causal_program_history_suffix [where sb="?take_sb"] )
	apply (simp)
	done
      from valid_last_prog [OF i_bound tssb_i] have last_prog: "last_prog psb sb = psb".
      then
      have lp: "last_prog psb ?drop_sb = psb"
	apply -
	apply (rule last_prog_same_append [where sb="?take_sb"])
	apply simp
	done

      from reads_consistent_flush_all_until_volatile_write [OF valid_own_sharing i_bound 
	tssb_i reads_consis]
      have reads_consis_m: "reads_consistent True (acquired True ?take_sb 𝒪sb) m ?drop_sb"
	by (simp add: m)
      
      from valid_history [OF i_bound tssb_i]
      have h_consis: "history_consistent θsb (hd_prog psb (?take_sb@?drop_sb)) (?take_sb@?drop_sb)"
	by (simp)
      
      have last_prog_hd_prog: "last_prog (hd_prog psb sb) ?take_sb = (hd_prog psb ?drop_sb)"
      proof -
	from last_prog_hd_prog_append' [OF h_consis] last_prog
	have "last_prog (hd_prog psb ?drop_sb) ?take_sb = hd_prog psb ?drop_sb"
	  by (simp)
	moreover 
	have "last_prog (hd_prog psb (?take_sb @ ?drop_sb)) ?take_sb = 
          last_prog (hd_prog psb ?drop_sb) ?take_sb"
	  by (rule last_prog_hd_prog_append)
	ultimately show ?thesis
	  by (simp)
      qed
       
      from valid_write_sops [OF i_bound tssb_i]
      have "sopwrite_sops (?take_sb@?drop_sb). valid_sop sop"
	by (simp)
      then obtain valid_sops_take: "sopwrite_sops ?take_sb. valid_sop sop" and
	valid_sops_drop: "sopwrite_sops ?drop_sb. valid_sop sop"
	apply (simp only: write_sops_append)
	apply auto
	done
	  
      from read_tmps_distinct [OF i_bound tssb_i]
      have "distinct_read_tmps (?take_sb@?drop_sb)"
	by (simp)
      then obtain 
	read_tmps_take_drop: "read_tmps ?take_sb  read_tmps ?drop_sb = {}" and
	distinct_read_tmps_drop: "distinct_read_tmps ?drop_sb"
	by (simp only: distinct_read_tmps_append)
      
      from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]	  
      have hist_consis': "history_consistent θsb (hd_prog psb ?drop_sb) ?drop_sb"
	by (simp add: last_prog_hd_prog)

      have rel_eq: "release ?drop_sb (dom 𝒮) (release  ?take_sb (dom 𝒮sb) sb) = 
                       release sb (dom 𝒮sb) sb"
      proof -
        from release_append [of ?take_sb ?drop_sb]
        have "release sb (dom 𝒮sb) sb =
                release ?drop_sb (dom (share ?take_sb 𝒮sb)) (release  ?take_sb (dom 𝒮sb) sb)"
          by simp
        also
        have dist: "ownership_distinct tssb" by fact
        have consis: "sharing_consis 𝒮sb tssb" by fact

        have "release ?drop_sb (dom (share ?take_sb 𝒮sb)) (release  ?take_sb (dom 𝒮sb) sb) =
              release ?drop_sb (dom 𝒮) (release  ?take_sb (dom 𝒮sb) sb) "
          apply (simp only: 𝒮)
          apply (rule release_shared_exchange_weak [rule_format, OF _ weak_consis_drop])
          apply (rule share_all_until_volatile_write_thread_local [OF dist consis i_bound tssb_i, symmetric])
          using acquired_all_acquired [of True ?take_sb 𝒪sb] all_acquired_append [of ?take_sb ?drop_sb]
          by auto
        finally
        show ?thesis by simp
      qed
      
      from flush_store_buffer [OF i_bound' is_sim [simplified suspends]
	cph ts_i [simplified suspends] refl lp reads_consis_m hist_consis' 
	valid_sops_drop distinct_read_tmps_drop no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], of 𝒮]
      show ?thesis by (simp add: acquired_take_drop [where pending_write=True, simplified] 𝒟sb rel_eq)
    qed

    from safe_reach_safe_rtrancl [OF safe_reach steps_flush_sb]
    have safe_ts': "safe_delayed (?ts', flush ?drop_sb m, share ?drop_sb 𝒮)".
    from safe_delayedE [OF safe_ts' i_bound_ts' ts'_i] 
    have safe_memop_flush_sb: "map owned ?ts',map released ?ts',i 
      (issb, θsb, flush ?drop_sb m, 𝒟sb,acquired True sb 𝒪sb,
        share ?drop_sb 𝒮) ".


    
    from acquired_takeWhile_non_volatile_Writesb 
    have acquired_take_sb: "acquired True ?take_sb 𝒪sb  𝒪sb  all_acquired ?take_sb ".

(* FIXME delete
    from share_takeWhile_non_volatile_Writesb
    have share_take_sb: "share ?take_sb 𝒮sb = 
      𝒮sb(all_acquired ?take_sb) all_unshared ?take_sb".

    from sharing_consis [OF i_bound tssb_i]
    have "sharing_consistent 𝒮sb 𝒪sb sb".

    with sharing_consistent_append [where xs="?take_sb" and ys="?drop_sb", of 𝒮sb 𝒪sb]
    have sharing_consis_drop_sb: 
      "sharing_consistent (share ?take_sb 𝒮sb) (acquired True ?take_sb 𝒪sb) ?drop_sb"
      by (simp add: acquired_take_sb share_takeWhile_non_volatile_Writesb)

    from read_only_takeWhile_dropWhile_share_all_until_volatile_write [OF i_bound tssb_i]
    have read_only_drop:
      "read_only (share ?drop_sb 𝒮) ⊆ read_only (share sb 𝒮sb)"
      by (simp add: 𝒮)
  *)  
    from sbh_step 
    show ?thesis
    proof (cases)
      case (SBHReadBuffered a v volatile t)
      then obtain 
	"issb": "issb = Read volatile a t # issb'" and
	𝒪sb': "𝒪sb'=𝒪sb" and 
	𝒟sb': "𝒟sb'=𝒟sb" and
	θsb': "θsb' = θsb(tv)" and
	sb': "sb'=sb@[Readsb volatile a t v]" and
	msb': "msb' = msb" and
	𝒮sb': "𝒮sb'=𝒮sb" andsb': "sb'=sb" and
	buf_v: "buffered_val sb a = Some v" 
	by auto


      from safe_memop_flush_sb [simplified issb]  
      obtain access_cond': "a  acquired True sb 𝒪sb  
	a  read_only (share ?drop_sb 𝒮)  
	(volatile  a  dom (share ?drop_sb 𝒮))" and
	volatile_clean: "volatile  ¬ 𝒟sb" and
        rels_cond: "j < length ts. ij  released (ts!j) a  Some False" and
        rels_nv_cond: "¬volatile  (j < length ts. ij  a  dom (released (ts!j)))"
	by cases auto

      from clean_no_outstanding_volatile_Writesb [OF i_bound tssb_i] volatile_clean
      have volatile_cond: "volatile  outstanding_refs is_volatile_Writesb sb ={}"
	by auto
      
      from buffered_val_witness [OF buf_v] obtain volatile' sop' A' L' R' W'
	where
	witness: "Writesb volatile' a sop' v A' L' R' W'  set sb"
	by auto

      (* FIXME: since this is the buffered-val case, there should be a simpler proof not involving simulation to an
         unsafe state. Then we would not have to repeat the proof.*)

      {
	fix j pj "issbj" 𝒪j j 𝒟sbj θsbj sbj
	assume j_bound: "j < length tssb"
	assume neq_i_j: "i  j"
	assume jth: "tssb!j = (pj,issbj, θsbj, sbj, 𝒟sbj, 𝒪j,j)"
	assume non_vol: "¬ volatile"
	have "a  𝒪j  all_acquired sbj"
	proof 
	  assume a_j: "a  𝒪j  all_acquired sbj"
	  let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	  let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"


          from ts_sim [rule_format, OF j_bound] jth
	  obtain suspendsj "isj" 𝒟j where
	    suspendsj: "suspendsj = ?drop_sbj" and
	    isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	    𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
	    tsj: "ts!j = (hd_prog pj suspendsj, isj, 
	    θsbj |` (dom θsbj - read_tmps suspendsj),(), 
	    𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	    by (auto simp add: Let_def)
	    

	  from a_j ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth]
	  have a_notin_sb: "a  𝒪sb  all_acquired sb"
	    by auto
	  with acquired_all_acquired [of True sb 𝒪sb]
	  have a_not_acq: "a  acquired True sb 𝒪sb" by blast
	  with access_cond' non_vol
	  have a_ro: "a  read_only (share ?drop_sb 𝒮)"
	    by auto
          from read_only_share_unowned_in [OF weak_consis_drop a_ro] a_notin_sb
            acquired_all_acquired [of True ?take_sb 𝒪sb]
            all_acquired_append [of ?take_sb ?drop_sb]
          have a_ro_shared: "a  read_only 𝒮"
            by auto

          from rels_nv_cond [rule_format, OF non_vol j_bound [simplified leq] neq_i_j] tsj
          have "a  dom (release ?take_sbj (dom (𝒮sb)) j)"
            by auto
          with dom_release_takeWhile [of sbj "(dom (𝒮sb))" j]
          obtain
            a_relsj: "a  dom j" and
            a_sharedj: "a  all_shared ?take_sbj"
            by auto
          
          
          have "a  ((λ(_, _, _, sb, _, _, _). all_shared (takeWhile (Not  is_volatile_Writesb) sb)) `
                 set tssb)"
          proof -
            {
              fix k pk "isk" θk sbk 𝒟k 𝒪k k 
              assume k_bound: "k < length tssb" 
              assume ts_k: "tssb ! k = (pk,isk,θk,sbk,𝒟k,𝒪k,k)" 
              assume a_in: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sbk)"
              have False
              proof (cases "k=j")
                case True with a_sharedj jth ts_k a_in show False by auto
              next
                case False
                from ownership_distinct [OF j_bound k_bound False [symmetric] jth ts_k] a_j
                have "a  (𝒪k  all_acquired sbk)" by auto
                with all_shared_acquired_or_owned [OF sharing_consis [OF k_bound ts_k]] a_in
                show False 
                using all_acquired_append [of "takeWhile (Not  is_volatile_Writesb) sbk" 
                  "dropWhile (Not  is_volatile_Writesb) sbk"] 
                  all_shared_append [of "takeWhile (Not  is_volatile_Writesb) sbk" 
                  "dropWhile (Not  is_volatile_Writesb) sbk"] by auto 
              qed
            }
            thus ?thesis by (fastforce simp add: in_set_conv_nth)
          qed
          with a_ro_shared
            read_only_shared_all_until_volatile_write_subset' [of tssb 𝒮sb]
          have a_ro_sharedsb: "a  read_only 𝒮sb"
            by (auto simp add: 𝒮)
          
	  with read_only_unowned [OF j_bound jth]
	  have a_notin_owns_j: "a  𝒪j"
	    by auto


	  have own_dist: "ownership_distinct tssb" by fact
	  have share_consis: "sharing_consis 𝒮sb tssb" by fact
	  from sharing_consistent_share_all_until_volatile_write [OF own_dist share_consis i_bound tssb_i]
	  have consis': "sharing_consistent 𝒮 (acquired True ?take_sb 𝒪sb) ?drop_sb"
	    by (simp add: 𝒮)
          from  share_all_until_volatile_write_thread_local [OF own_dist share_consis j_bound jth a_j] a_ro_shared
          have a_ro_take: "a  read_only (share ?take_sbj 𝒮sb)"
            by (auto simp add: domIff 𝒮 read_only_def)
          from sharing_consis [OF j_bound jth]
          have "sharing_consistent 𝒮sb 𝒪j sbj".
          from sharing_consistent_weak_sharing_consistent [OF this] weak_sharing_consistent_append [of 𝒪j ?take_sbj ?drop_sbj]
          have weak_consis_drop:"weak_sharing_consistent 𝒪j ?take_sbj"
            by auto
          from read_only_share_acquired_all_shared [OF this read_only_unowned [OF j_bound jth] a_ro_take ] a_notin_owns_j a_sharedj
          have "a  all_acquired ?take_sbj"
            by auto
	  with a_j a_notin_owns_j
	  have a_drop: "a  all_acquired ?drop_sbj"
	    using all_acquired_append [of ?take_sbj ?drop_sbj]
	    by simp
	  

	  from i_bound j_bound leq have j_bound_ts': "j < length ?ts'"
	    by auto

	  note conflict_drop = a_drop [simplified suspendsj [symmetric]]
	  from split_all_acquired_in [OF conflict_drop]
	    (* FIXME: exract common parts *)
	  show False
	  proof 
	    assume "sop a' v ys zs A L R W. 
              (suspendsj = ys @ Writesb True a' sop v A L R W# zs)  a  A"
	    then 
	    obtain a' sop' v' ys zs A' L' R' W' where
	      split_suspendsj: "suspendsj = ys @ Writesb True a' sop' v' A' L' R' W'# zs" 
	      (is "suspendsj = ?suspends") and
		a_A': "a  A'"
	      by blast

	    from sharing_consis [OF j_bound jth]
	    have "sharing_consistent 𝒮sb 𝒪j sbj".
	    then have A'_R': "A'  R' = {}" 
	      by (simp add: sharing_consistent_append [of _ _ ?take_sbj ?drop_sbj, simplified] 
		suspendsj [symmetric] split_suspendsj sharing_consistent_append)
	    from valid_program_history [OF j_bound jth] 
	    have "causal_program_history issbj sbj".
	    then have cph: "causal_program_history issbj ?suspends"
	      apply -
	      apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply (simp add: split_suspendsj)
	      done

	    from tsj neq_i_j j_bound 
	    have ts'_j: "?ts'!j = (hd_prog pj suspendsj, isj,
	      θsbj |` (dom θsbj - read_tmps suspendsj),(), 
	      𝒟j, acquired True ?take_sbj 𝒪j, release ?take_sbj (dom 𝒮sb) j)"
	      by auto
	    from valid_last_prog [OF j_bound jth] have last_prog: "last_prog pj sbj = pj".
	    then
	    have lp: "last_prog pj suspendsj = pj"
	      apply -
	      apply (rule last_prog_same_append [where sb="?take_sbj"])
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	    from valid_reads [OF j_bound jth]
	    have reads_consis_j: "reads_consistent False 𝒪j msb sbj".
	    from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb j_bound 
	      jth reads_consis_j]
	    have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
	      by (simp add: m suspendsj)


	    from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j tssb_i jth]
	    have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
	      by (simp add: suspendsj)
	    from reads_consistent_flush_independent [OF this reads_consis_m_j]
	    have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	      (flush ?drop_sb m) suspendsj".
	    hence reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	      (flush ?drop_sb m) (ys@[Writesb True a' sop' v' A' L' R' W'])"
	      by (simp add: split_suspendsj reads_consistent_append)

	    from valid_write_sops [OF j_bound jth]
	    have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
	      valid_sops_drop: "sopwrite_sops (ys@[Writesb True a' sop' v' A' L' R' W']). valid_sop sop"
	      apply (simp only: write_sops_append)
	      apply auto
	      done

	    from read_tmps_distinct [OF j_bound jth]
	    have "distinct_read_tmps (?take_sbj@suspendsj)"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain 
	      read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
	      distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
	      apply (simp only: split_suspendsj [symmetric] suspendsj) 
	      apply (simp only: distinct_read_tmps_append)
	      done

	    from valid_history [OF j_bound jth]
	    have h_consis: 
	      "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	    
	    have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	    proof -
	      from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		by simp
	      from last_prog_hd_prog_append' [OF h_consis] this
	      have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		by (simp only: split_suspendsj [symmetric] suspendsj) 
	      moreover 
	      have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		last_prog (hd_prog pj suspendsj) ?take_sbj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		by (rule last_prog_hd_prog_append)
	      ultimately show ?thesis
		by (simp add: split_suspendsj [symmetric] suspendsj) 
	    qed

	    from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
	      h_consis] last_prog_hd_prog
	    have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    from reads_consistent_drop_volatile_writes_no_volatile_reads  
	    [OF reads_consis_j] 
	    have no_vol_read: "outstanding_refs is_volatile_Readsb 
	      (ys@[Writesb True a' sop' v' A' L' R' W']) = {}"
	      by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )

	    have acq_simp:
	      "acquired True (ys @ [Writesb True a' sop' v' A' L' R' W']) 
              (acquired True ?take_sbj 𝒪j) = 
              acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R'"
	      by (simp add: acquired_append)

	    from flush_store_buffer_append [where sb="ys@[Writesb True a' sop' v' A' L' R' W']" and sb'="zs", simplified,
	      OF j_bound_ts' isj [simplified split_suspendsj] cph [simplified suspendsj]
	      ts'_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys 
	      hist_consis' [simplified split_suspendsj] valid_sops_drop 
	      distinct_read_tmps_drop [simplified split_suspendsj] 
	      no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="share ?drop_sb 𝒮"]

	    obtain isj' j' where
	      isj': "instrs zs @ issbj = isj' @ prog_instrs zs" and
	      steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮)  d* 
	      (?ts'[j:=(last_prog
              (hd_prog pj (Writesb True a' sop' v' A' L' R' W'# zs)) (ys@[Writesb True a' sop' v' A' L' R' W']),
              isj',
              θsbj |` (dom θsbj - read_tmps zs),
              (), True, acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R',j')],
              flush (ys@[Writesb True a' sop' v' A' L' R' W']) (flush ?drop_sb m),
              share (ys@[Writesb True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
	      (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")

              by (auto simp add: acquired_append outstanding_refs_append)

	    from i_bound' have i_bound_ys: "i < length ?ts_ys"
	      by auto

	    from i_bound' neq_i_j 
	    have ts_ys_i: "?ts_ys!i = (psb, issb, θsb,(), 
	      𝒟sb, acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb)"
	      by simp
	    note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
	    
	    from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	    have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	    from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified issb] non_vol a_not_acq
	    have "a  read_only (share (ys@[Writesb True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
	      apply cases
	      apply (auto simp add: Let_def issb)
	      done

	    with a_A'
	    show False
	      by (simp add: share_append in_read_only_convs)
	  next
	    assume "A L R W ys zs. suspendsj = ys @ Ghostsb A L R W # zs  a  A"
	    then 
	    obtain A' L' R' W' ys zs where
	      split_suspendsj: "suspendsj = ys @ Ghostsb A' L' R' W'# zs" 
	      (is "suspendsj = ?suspends") and
		a_A': "a  A'"
	      by blast

	    from valid_program_history [OF j_bound jth] 
	    have "causal_program_history issbj sbj".
	    then have cph: "causal_program_history issbj ?suspends"
	      apply -
	      apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply (simp add: split_suspendsj)
	      done

	    from tsj neq_i_j j_bound 
	    have ts'_j: "?ts'!j = (hd_prog pj suspendsj, isj,
	      θsbj |` (dom θsbj - read_tmps suspendsj),(), 
	      𝒟j, acquired True ?take_sbj 𝒪j, release ?take_sbj (dom 𝒮sb) j)"
	      by auto
	    from valid_last_prog [OF j_bound jth] have last_prog: "last_prog pj sbj = pj".
	    then
	    have lp: "last_prog pj suspendsj = pj"
	      apply -
	      apply (rule last_prog_same_append [where sb="?take_sbj"])
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done


	    from valid_reads [OF j_bound jth]
	    have reads_consis_j: "reads_consistent False 𝒪j msb sbj".
	    from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb j_bound 
	      jth reads_consis_j]
	    have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
	      by (simp add: m suspendsj)

	    from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j tssb_i jth]
	    have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
	      by (simp add: suspendsj)
	    from reads_consistent_flush_independent [OF this reads_consis_m_j]
	    have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	      (flush ?drop_sb m) suspendsj".

	    hence reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  
	      (flush ?drop_sb m) (ys@[Ghostsb A' L' R' W'])"
	      by (simp add: split_suspendsj reads_consistent_append)
	    from valid_write_sops [OF j_bound jth]
	    have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
	      valid_sops_drop: "sopwrite_sops (ys@[Ghostsb A' L' R' W']). valid_sop sop"
	      apply (simp only: write_sops_append)
	      apply auto
	      done

	    from read_tmps_distinct [OF j_bound jth]
	    have "distinct_read_tmps (?take_sbj@suspendsj)"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain 
	      read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
	      distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
	      apply (simp only: split_suspendsj [symmetric] suspendsj) 
	      apply (simp only: distinct_read_tmps_append)
	      done

	    from valid_history [OF j_bound jth]
	    have h_consis: 
	      "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	    
	    have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	    proof -
	      from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		by simp
	      from last_prog_hd_prog_append' [OF h_consis] this
	      have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		by (simp only: split_suspendsj [symmetric] suspendsj) 
	      moreover 
	      have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		last_prog (hd_prog pj suspendsj) ?take_sbj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		by (rule last_prog_hd_prog_append)
	      ultimately show ?thesis
		by (simp add: split_suspendsj [symmetric] suspendsj) 
	    qed

	    from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
	      h_consis] last_prog_hd_prog
	    have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    from reads_consistent_drop_volatile_writes_no_volatile_reads  
	    [OF reads_consis_j] 
	    have no_vol_read: "outstanding_refs is_volatile_Readsb 
	      (ys@[Ghostsb A' L' R' W']) = {}"
	      by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )

	    have acq_simp:
	      "acquired True (ys @ [Ghostsb A' L' R' W']) 
              (acquired True ?take_sbj 𝒪j) = 
              acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R'"
	      by (simp add: acquired_append)

	    from flush_store_buffer_append [where sb="ys@[Ghostsb A' L' R' W']" and sb'="zs", simplified,
	      OF j_bound_ts' isj [simplified split_suspendsj] cph [simplified suspendsj]
	      ts'_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys 
	      hist_consis' [simplified split_suspendsj] valid_sops_drop 
	      distinct_read_tmps_drop [simplified split_suspendsj] 
	      no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="share ?drop_sb 𝒮"]
	    obtain isj' j' where
	      isj': "instrs zs @ issbj = isj' @ prog_instrs zs" and
	      steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮)  d* 
	      (?ts'[j:=(last_prog
              (hd_prog pj (Ghostsb A' L' R' W'# zs)) (ys@[Ghostsb A' L' R' W']),
              isj',
              θsbj |` (dom θsbj - read_tmps zs),
              (),
              𝒟j  outstanding_refs is_volatile_Writesb (ys @ [Ghostsb A' L' R' W'])  {}, acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R',j')],
              flush (ys@[Ghostsb A' L' R' W']) (flush ?drop_sb m),
              share (ys@[Ghostsb A' L' R' W']) (share ?drop_sb 𝒮))"
	      (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
              by (auto simp add: acquired_append)

	    from i_bound' have i_bound_ys: "i < length ?ts_ys"
	      by auto

	    from i_bound' neq_i_j 
	    have ts_ys_i: "?ts_ys!i = (psb, issb,θsb,(), 
	      𝒟sb, acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb)"
	      by simp
	    note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
	    
	    from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	    have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	    from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified issb] non_vol a_not_acq
	    have "a  read_only (share (ys@[Ghostsb A' L' R' W']) (share ?drop_sb 𝒮))"
	      apply cases
	      apply (auto simp add: Let_def issb)
	      done

	    with a_A'
	    show False
	      by (simp add: share_append in_read_only_convs)
	  qed
	qed
      }
      note non_volatile_unowned_others = this

      {
        assume a_in: "a  read_only (share (dropWhile (Not  is_volatile_Writesb) sb) 𝒮)"
        assume nv: "¬ volatile"
        have "a  read_only (share sb 𝒮sb)"
        proof (cases "a  𝒪sb  all_acquired sb")
          case True
          from share_all_until_volatile_write_thread_local' [OF ownership_distinct_tssb 
            sharing_consis_tssb i_bound tssb_i True] True a_in
          show ?thesis
            by (simp add: 𝒮 read_only_def)
        next
          case False
          from read_only_share_unowned [OF weak_consis_drop _ a_in] False 
            acquired_all_acquired [of True ?take_sb 𝒪sb] all_acquired_append [of ?take_sb ?drop_sb]
          have a_ro_shared: "a  read_only 𝒮"
            by auto
          
          have "a  ((λ(_, _, _, sb, _, _, _).
               all_shared (takeWhile (Not  is_volatile_Writesb) sb)) ` set tssb)"
          proof -
            {
              fix k pk "isk" θk sbk 𝒟k 𝒪k k 
              assume k_bound: "k < length tssb" 
              assume ts_k: "tssb ! k = (pk,isk,θk,sbk,𝒟k,𝒪k,k)" 
              assume a_in: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sbk)"
              have False
              proof (cases "k=i")
                case True with False tssb_i ts_k a_in 
                  all_shared_acquired_or_owned [OF sharing_consis [OF k_bound ts_k]]     
                  all_shared_append [of "takeWhile (Not  is_volatile_Writesb) sbk" 
                  "dropWhile (Not  is_volatile_Writesb) sbk"] show False by auto
              next
                case False
                from rels_nv_cond [rule_format, OF nv k_bound [simplified leq] False [symmetric] ] 
                ts_sim [rule_format, OF k_bound] ts_k
                have "a  dom (release (takeWhile (Not  is_volatile_Writesb) sbk) (dom (𝒮sb)) k)"
                  by (auto simp add: Let_def)
                with dom_release_takeWhile [of sbk "(dom (𝒮sb))" k]
                obtain
                  a_relsj: "a  dom k" and
                  a_sharedj: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sbk)"
                  by auto
                with False a_in show ?thesis 
                  by auto
             qed
           }      
           thus ?thesis by (fastforce simp add: in_set_conv_nth)
          qed
          with read_only_shared_all_until_volatile_write_subset' [of tssb 𝒮sb] a_ro_shared
          have "a  read_only 𝒮sb"
            by (auto simp add: 𝒮)
          from read_only_share_unowned' [OF weak_consis_sb read_only_unowned [OF i_bound tssb_i] False  this]
          show ?thesis .
        qed
      } note non_vol_ro_reduction = this

      have valid_own': "valid_ownership 𝒮sb' tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	proof (cases volatile)
	  case False
	  from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i]
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb sb".
	  then

	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb (sb@[Readsb False a t v])"
	    using  access_cond' False non_vol_ro_reduction
	    by (auto simp add: non_volatile_owned_or_read_only_append)
            
	  from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	  show ?thesis by (auto simp add: False tssb' sb' 𝒪sb' 𝒮sb')
	next
	  case True
	  from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i]  
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb sb".
	  then
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb (sb@[Readsb True a t v])"
	    using True
	    by (simp add: non_volatile_owned_or_read_only_append)
	  from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	  show ?thesis by (auto simp add: True tssb' sb' 𝒪sb' 𝒮sb')
	qed
      next
	show "outstanding_volatile_writes_unowned_by_others tssb'"
	proof -
	  have out: "outstanding_refs is_volatile_Writesb (sb @ [Readsb volatile a t v])  
            outstanding_refs is_volatile_Writesb sb"
	    by (auto simp add: outstanding_refs_append)
	  have "all_acquired (sb @ [Readsb volatile a t v])  all_acquired sb"
	    by (auto simp add: all_acquired_append)
	  from outstanding_volatile_writes_unowned_by_others_store_buffer 
	  [OF i_bound tssb_i out this]
	  show ?thesis by (simp add: tssb' sb' 𝒪sb')
	qed
      next
	show "read_only_reads_unowned tssb'"
	proof (cases volatile)
	  case True
	  have r: "read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) (sb @ [Readsb volatile a t v])) 𝒪sb)
                    (dropWhile (Not  is_volatile_Writesb) (sb @ [Readsb volatile a t v]))
                 read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪sb)
                    (dropWhile (Not  is_volatile_Writesb) sb)"
	    apply (case_tac "outstanding_refs (is_volatile_Writesb) sb = {}")
	    apply (simp_all add: outstanding_vol_write_take_drop_appends
	    acquired_append read_only_reads_append True)
	    done

	  have "𝒪sb  all_acquired (sb @ [Readsb volatile a t v])  𝒪sb  all_acquired sb"
	    by (simp add: all_acquired_append)

	 
	  from  read_only_reads_unowned_nth_update [OF i_bound tssb_i r this]
	  show ?thesis
	    by (simp add: tssb' 𝒪sb' sb')
	next
	  case False
	  show ?thesis
	  proof (unfold_locales)
	    fix n m
	    fix pn "isn" 𝒪n n 𝒟n θn sbn pm "ism" 𝒪m m 𝒟m θm sbm
	    assume n_bound: "n < length tssb'"
	    and m_bound: "m < length tssb'"
	    and neq_n_m: "nm"
	    and nth: "tssb'!n = (pn, isn, θn, sbn, 𝒟n, 𝒪n, n)"
	    and mth: "tssb'!m =(pm, ism, θm, sbm, 𝒟m, 𝒪m, m)"
	    from n_bound have n_bound': "n < length tssb" by (simp add: tssb')
	    from m_bound have m_bound': "m < length tssb" by (simp add: tssb')

	    have acq_eq: "(𝒪sb'  all_acquired sb') = (𝒪sb  all_acquired sb)"
	      by (simp add: all_acquired_append sb' 𝒪sb')	      

	    show "(𝒪m  all_acquired sbm) 
              read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbn) 𝒪n)
              (dropWhile (Not  is_volatile_Writesb) sbn) =
              {}"
	    proof (cases "m=i")
	      case True
	      with neq_n_m have neq_n_i: "ni"
		by auto
		
	      with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n, n)"
		by (auto simp add: tssb')
	      note read_only_reads_unowned [OF n_bound' i_bound  neq_n_i nth' tssb_i]
	      moreover
	      note acq_eq
	      ultimately show ?thesis
		using True tssb_i nth mth n_bound' m_bound'
		by (simp add: tssb')
	    next
	      case False
	      note neq_m_i = this
	      with m_bound mth i_bound have mth': "tssb!m = (pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
		by (auto simp add: tssb')
	      show ?thesis
	      proof (cases "n=i")
		case True
		note read_only_reads_unowned [OF i_bound m_bound' neq_m_i [symmetric] tssb_i mth']
		moreover 
		note acq_eq
		moreover
		note non_volatile_unowned_others [OF m_bound' neq_m_i [symmetric] mth']
		ultimately show ?thesis
		  using True tssb_i nth mth n_bound' m_bound' neq_m_i
		  apply (case_tac "outstanding_refs (is_volatile_Writesb) sb = {}")
		  apply (clarsimp simp add: outstanding_vol_write_take_drop_appends
		    acquired_append read_only_reads_append tssb' sb' 𝒪sb')+
		  done
	      next
		case False
		with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n, n)"
		  by (auto simp add: tssb')
		from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m  nth' mth'] False neq_m_i
		show ?thesis 
		  by (clarsimp)
	      qed
	    qed
	  qed
	qed
      next
	show "ownership_distinct tssb'"
	proof -
	  have "all_acquired (sb @ [Readsb volatile a t v])  all_acquired sb"
	    by (auto simp add: all_acquired_append)
	  from ownership_distinct_instructions_read_value_store_buffer_independent 
	  [OF i_bound tssb_i this]
	  show ?thesis by (simp add: tssb' sb' 𝒪sb')
	qed
      qed


      have valid_hist': "valid_history program_step tssb'"
      proof -
	from valid_history [OF i_bound tssb_i]
	have hcons: "history_consistent θsb (hd_prog psb sb) sb".
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i]
	have t_notin_reads: "t  read_tmps sb"
	  by (auto simp add: "issb")
	from load_tmps_write_tmps_distinct [OF i_bound tssb_i]
	have t_notin_writes: "t  (fst ` write_sops sb)"
	  by (auto simp add: "issb")

	from valid_write_sops [OF i_bound tssb_i]
	have valid_sops: "sop  write_sops sb. valid_sop sop"
	  by auto
	from load_tmps_fresh [OF i_bound tssb_i]
	have t_fresh: "t  dom θsb"
	  using "issb"
	  by simp
	have "history_consistent (θsb(tv)) 
	       (hd_prog psb (sb@ [Readsb volatile a t v])) (sb@ [Readsb volatile a t v])"
	  using t_notin_writes valid_sops t_fresh hcons
	  valid_implies_valid_prog_hd [OF i_bound tssb_i valid]
	  apply -
	  apply (rule history_consistent_appendI)
	  apply (auto simp add: hd_prog_append_Readsb)
	  done
	from valid_history_nth_update [OF i_bound this]
	show ?thesis
	  by (auto simp add: tssb' sb' 𝒪sb' θsb')
      qed

      from reads_consistent_buffered_snoc [OF buf_v valid_reads [OF i_bound tssb_i] 
	volatile_cond] 
      have reads_consis': "reads_consistent False 𝒪sb msb (sb @ [Readsb volatile a t v])"
	by (simp split: if_split_asm)

      from valid_reads_nth_update [OF i_bound this]
      have valid_reads': "valid_reads msb tssb'" by (simp add: tssb' sb' 𝒪sb')

      have valid_sharing': "valid_sharing 𝒮sb' tssb'"
      proof (intro_locales)	
	from outstanding_non_volatile_writes_unshared [OF i_bound tssb_i]
	have "non_volatile_writes_unshared 𝒮sb (sb @ [Readsb volatile a t v])"
	  by (auto simp add: non_volatile_writes_unshared_append)
	from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
	show "outstanding_non_volatile_writes_unshared 𝒮sb' tssb'"
	  by (simp add: tssb' sb' 𝒮sb')
      next
	from sharing_consis [OF i_bound tssb_i]
	have "sharing_consistent 𝒮sb 𝒪sb sb".
	then
	have "sharing_consistent 𝒮sb 𝒪sb (sb @ [Readsb volatile a t v])"
	  by (simp add:  sharing_consistent_append)
	from sharing_consis_nth_update [OF i_bound this]
	show "sharing_consis 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒪sb' sb' 𝒮sb')
      next
	note read_only_unowned [OF i_bound tssb_i]
	from read_only_unowned_nth_update [OF i_bound this]
	show "read_only_unowned 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' sb' 𝒪sb')
      next
	from unowned_shared_nth_update [OF i_bound tssb_i subset_refl]
	show "unowned_shared 𝒮sb' tssb'" by (simp add: tssb' 𝒪sb' 𝒮sb')
      next
	from no_outstanding_write_to_read_only_memory [OF i_bound tssb_i]
	have "no_write_to_read_only_memory 𝒮sb sb".
	hence "no_write_to_read_only_memory 𝒮sb (sb@[Readsb volatile a t v])"
	  by (simp add: no_write_to_read_only_memory_append)
	from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
	show "no_outstanding_write_to_read_only_memory 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒮sb' sb')
      qed

      have tmps_distinct': "tmps_distinct tssb'"
      proof (intro_locales)
	from load_tmps_distinct [OF i_bound tssb_i]
	have "distinct_load_tmps issb'"
	  by (auto split: instr.splits simp add: issb)
	from load_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_distinct tssb'" by (simp add: tssb')
      next
	from read_tmps_distinct [OF i_bound tssb_i]
	have "distinct_read_tmps sb".
	moreover
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i]
	have "t  read_tmps sb"
	  by (auto simp add: issb)
	ultimately have "distinct_read_tmps (sb @ [Readsb volatile a t v])"
	  by (auto simp add: distinct_read_tmps_append)
	from read_tmps_distinct_nth_update [OF i_bound this]
	show "read_tmps_distinct tssb'" by (simp add: tssb' sb')
      next
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i] 
          load_tmps_distinct [OF i_bound tssb_i]
	have "load_tmps issb'  read_tmps (sb @ [Readsb volatile a t v]) = {}"
	  by (clarsimp simp add: read_tmps_append "issb")
	from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_read_tmps_distinct tssb'" by (simp add: tssb' sb')
      qed

      have valid_sops': "valid_sops tssb'"
      proof -
	from valid_store_sops [OF i_bound tssb_i]
	have valid_store_sops': "sopstore_sops issb'. valid_sop sop"
	  by (auto simp add: "issb")
	from valid_write_sops [OF i_bound tssb_i]
	have valid_write_sops': "sopwrite_sops (sb@ [Readsb volatile a t v]). valid_sop sop"
	  by (auto simp add: write_sops_append)
	from valid_sops_nth_update [OF i_bound  valid_write_sops' valid_store_sops']
	show ?thesis by (simp add: tssb' sb')
      qed

      have valid_dd': "valid_data_dependency tssb'"
      proof -
	from data_dependency_consistent_instrs [OF i_bound tssb_i]
	have dd_is: "data_dependency_consistent_instrs (dom θsb') issb'"
	  by (auto simp add: "issb" θsb')
	from load_tmps_write_tmps_distinct [OF i_bound tssb_i]
	have "load_tmps issb'  (fst ` write_sops (sb@ [Readsb volatile a t v])) = {}"
	  by (auto simp add: write_sops_append "issb")
	from valid_data_dependency_nth_update [OF i_bound dd_is this]
	show ?thesis by (simp add: tssb' sb')
      qed

      have load_tmps_fresh': "load_tmps_fresh tssb'"
      proof -
	from load_tmps_fresh [OF i_bound tssb_i] 
	have "load_tmps (Read volatile a t # issb')  dom θsb = {}"
	  by (simp add: "issb")
	moreover
	from load_tmps_distinct [OF i_bound tssb_i] have "t  load_tmps issb'"
	  by (auto simp add: "issb")
	ultimately have "load_tmps issb'  dom (θsb(t  v)) = {}"
	  by auto
	from load_tmps_fresh_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' θsb')
      qed

      have enough_flushs': "enough_flushs tssb'"
      proof -
	from clean_no_outstanding_volatile_Writesb [OF i_bound tssb_i]
	have "¬ 𝒟sb  outstanding_refs is_volatile_Writesb (sb@[Readsb volatile a t v]) = {}"
	  by (auto simp add: outstanding_refs_append )
	from enough_flushs_nth_update [OF i_bound this]
	show ?thesis
	  by (simp add: tssb' sb' 𝒟sb')
      qed
	
      have valid_program_history': "valid_program_history tssb'"
      proof -	
	from valid_program_history [OF i_bound tssb_i]
	have "causal_program_history issb sb" .
	then have causal': "causal_program_history issb' (sb@[Readsb volatile a t v])"
	  by (auto simp: causal_program_history_Read  "issb")
	from valid_last_prog [OF i_bound tssb_i]
	have "last_prog psb sb = psb".
	hence "last_prog psb (sb @ [Readsb volatile a t v]) = psb"
	  by (simp add: last_prog_append_Readsb)

	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb' sb')
      qed
      show ?thesis
      proof (cases "outstanding_refs is_volatile_Writesb sb = {}")
	case True 

	from True have flush_all: "takeWhile (Not  is_volatile_Writesb) sb = sb"
	  by (auto simp add: outstanding_refs_conv )

	from True have suspend_nothing: "dropWhile (Not  is_volatile_Writesb) sb = []"
	  by (auto simp add: outstanding_refs_conv)

	hence suspends_empty: "suspends = []"
	  by (simp add: suspends)
	from suspends_empty is_sim have "is": "is = Read volatile a t # issb'"
	  by (simp add: "issb")
	with suspends_empty ts_i 
	have ts_i: "ts!i = (psb, Read volatile a t # issb', θsb,(), 𝒟, acquired True ?take_sb 𝒪sb, release ?take_sb (dom 𝒮sb) sb)"
	  by simp

	from direct_memop_step.Read 
	have "(Read volatile a t # issb', θsb, (), m, 𝒟, acquired True ?take_sb 𝒪sb,
                release ?take_sb (dom 𝒮sb) sb, 𝒮)  
          (issb', θsb(t  m a), (), m, 𝒟, acquired True ?take_sb 𝒪sb,release ?take_sb (dom 𝒮sb) sb, 𝒮)".
	from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
	have "(ts, m, 𝒮) d (ts[i := (psb, issb',  θsb(t  m a), (),
               𝒟, acquired True ?take_sb 𝒪sb, release ?take_sb (dom 𝒮sb) sb)], m, 𝒮)" . 

	moreover
	
	from flush_all_until_volatile_write_Read_commute [OF i_bound tssb_i [simplified "issb"] ]
	have flush_commute: "flush_all_until_volatile_write
          (tssb[i := (psb,issb', 
               θsb(tv), sb @ [Readsb volatile a t v], 𝒟sb, 𝒪sb, sb)]) msb =
          flush_all_until_volatile_write tssb msb".

	from True witness have not_volatile': "volatile' = False"
	  by (auto simp add: outstanding_refs_conv)

	from witness not_volatile' have a_out_sb: "a  outstanding_refs (Not  is_volatile) sb"
	  apply (cases sop')
	  apply (fastforce simp add: outstanding_refs_conv is_volatile_def split: memref.splits)
	  done

	
	with  non_volatile_owned_or_read_only_outstanding_refs 
	[OF outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i]]
	have a_owned: "a  𝒪sb  all_acquired sb  read_only_reads 𝒪sb sb"
	  by auto

	have "flush_all_until_volatile_write tssb msb a = v"
	proof - (* FIXME: Same proof as in Unbuffered case *)
          have "j < length tssb. i  j 
                  (let (_,_,_,sbj,_,_,_) = tssb!j 
                  in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))"
	  proof -
	    {
	      fix j pj "isj" 𝒪j j 𝒟j xsj sbj
	      assume j_bound: "j < length tssb"
	      assume neq_i_j: "i  j"
	      assume jth: "tssb!j = (pj,isj, xsj, sbj, 𝒟j, 𝒪j, j)"
	      have "a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	      proof 
		let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
		let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"
		assume a_in: "a  outstanding_refs is_non_volatile_Writesb ?take_sbj"
		with outstanding_refs_takeWhile [where P'= "Not  is_volatile_Writesb"]
		have a_in': "a  outstanding_refs is_non_volatile_Writesb sbj"
		  by auto
		with non_volatile_owned_or_read_only_outstanding_non_volatile_writes 
		[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]]
		have j_owns: "a  𝒪j  all_acquired sbj"
		  by auto
		with ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth]
		have a_not_owns: "a  𝒪sb  all_acquired sb"
		  by blast
		

		from non_volatile_owned_or_read_only_append [of False 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
		  outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]
		have "non_volatile_owned_or_read_only False 𝒮sb 𝒪j ?take_sbj"
		  by simp
		from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF this] a_in
		have j_owns_drop: "a  𝒪j  all_acquired ?take_sbj"
		  by auto
                from rels_cond [rule_format, OF j_bound [simplified leq] neq_i_j] ts_sim [rule_format, OF j_bound] jth
                have no_unsharing:"release ?take_sbj (dom (𝒮sb)) j  a  Some False"
                  by (auto simp add: Let_def)

	
		{
		  assume "a  acquired True sb 𝒪sb"
		  with acquired_all_acquired_in [OF this] ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth] 
		    j_owns 
		  have False
		    by auto
		}
		moreover
		{
		  assume a_ro: "a  read_only (share ?drop_sb 𝒮)"
                  
                  from read_only_share_unowned_in [OF weak_consis_drop a_ro] a_not_owns
                  acquired_all_acquired [of True ?take_sb 𝒪sb]
                  all_acquired_append [of ?take_sb ?drop_sb]
                  have "a  read_only 𝒮"
                    by auto
                  with share_all_until_volatile_write_thread_local [OF ownership_distinct_tssb sharing_consis_tssb j_bound jth j_owns]
                  have "a  read_only (share ?take_sbj 𝒮sb)"
                    by (auto simp add: read_only_def 𝒮)
                  hence a_dom: "a  dom  (share ?take_sbj 𝒮sb)"
                    by (auto simp add: read_only_def domIff)
                  from outstanding_non_volatile_writes_unshared [OF j_bound jth]
                  non_volatile_writes_unshared_append [of 𝒮sb ?take_sbj ?drop_sbj]
                  have nvw: "non_volatile_writes_unshared 𝒮sb ?take_sbj" by auto
                  from release_not_unshared_no_write_take [OF this no_unsharing a_dom] a_in
                  have False by auto
		}
		moreover
		{
		  assume a_share: "volatile  a  dom (share ?drop_sb 𝒮)"
		  from outstanding_non_volatile_writes_unshared [OF j_bound jth]
		  have "non_volatile_writes_unshared 𝒮sb sbj".
		  with non_volatile_writes_unshared_append [of 𝒮sb "?take_sbj"
		  "?drop_sbj"]
		  have unshared_take: "non_volatile_writes_unshared 𝒮sb (takeWhile (Not  is_volatile_Writesb) sbj)" 
		    by clarsimp
		   
		  from valid_own have own_dist: "ownership_distinct tssb"
		    by (simp add: valid_ownership_def)
		  from valid_sharing have "sharing_consis 𝒮sb tssb"
		    by (simp add: valid_sharing_def)
		  from sharing_consistent_share_all_until_volatile_write [OF own_dist this i_bound tssb_i]
		  have sc: "sharing_consistent 𝒮 (acquired True ?take_sb 𝒪sb) ?drop_sb"
		    by (simp add: 𝒮)
		  from sharing_consistent_share_all_shared 
		  have "dom (share ?drop_sb 𝒮)  dom 𝒮  all_shared ?drop_sb"
		    by auto
		  also from sharing_consistent_all_shared [OF sc]
		  have "  dom 𝒮  acquired True ?take_sb 𝒪sb" by auto
		  also from acquired_all_acquired all_acquired_takeWhile 
		  have "  dom 𝒮  (𝒪sb  all_acquired sb)" by force
		  finally
		  have a_shared: "a  dom 𝒮"
		    using a_share a_not_owns
		    by auto

                  with share_all_until_volatile_write_thread_local [OF ownership_distinct_tssb sharing_consis_tssb j_bound jth j_owns]
                  have a_dom: "a  dom  (share ?take_sbj 𝒮sb)"
                    by (auto simp add: 𝒮 domIff)
                  from release_not_unshared_no_write_take [OF  unshared_take no_unsharing a_dom] a_in
                  have False by auto

		}
		ultimately show False
		  using access_cond'
		  by auto
	      qed
	    }
	    thus ?thesis
	      by (fastforce simp add: Let_def)
	  qed
	  
	  from flush_all_until_volatile_write_buffered_val_conv 
	  [OF True i_bound tssb_i this]
	  show ?thesis
	    by (simp add: buf_v)
	qed


	hence m_a_v: "m a = v"
	  by (simp add: m)
	
	have tmps_commute: "θsb(t  v) = (θsb |` (dom θsb - {t}))(t  v)"
	  apply (rule ext)
	  apply (auto simp add: restrict_map_def domIff)
	  done

	from suspend_nothing
	have suspend_nothing': "(dropWhile (Not  is_volatile_Writesb) sb') = []"
	  by (simp add: sb')

	from 𝒟
	have 𝒟': "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb (sb@[Readsb volatile a t v])   {})"
	  by (auto simp: outstanding_refs_append)

	have "(tssb',msb,𝒮sb')  (ts[i := (psb,issb',
                θsb(tm a),(),𝒟, acquired True ?take_sb 𝒪sb,
                release ?take_sb (dom 𝒮sb) sb)],m,𝒮)"
	  apply (rule sim_config.intros) 
	  apply    (simp add: m flush_commute tssb' 𝒪sb' θsb' sb' 𝒟sb' ℛsb')
	  using   share_all_until_volatile_write_Read_commute [OF i_bound tssb_i [simplified issb]]
	  apply   (simp add: 𝒮 𝒮sb' tssb' sb' 𝒪sb' θsb' ℛsb')
	  using  leq
	  apply  (simp add: tssb')
	  using i_bound i_bound' ts_sim ts_i True 𝒟' 
	  apply (clarsimp simp add: Let_def nth_list_update 
	    outstanding_refs_conv m_a_v  tssb' 𝒪sb' 𝒮sb' θsb' sb' ℛsb' suspend_nothing' 
	    𝒟sb' flush_all acquired_append release_append
	    split: if_split_asm )
	  apply (rule tmps_commute)
	  done	

	ultimately show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct'
	    valid_sops' valid_dd' load_tmps_fresh' enough_flushs' 
            valid_program_history' valid'
	    msb' 𝒮sb' 𝒪sb'
	  by (auto simp del: fun_upd_apply )
      next
	case False

	then obtain r where r_in: "r  set sb" and volatile_r: "is_volatile_Writesb r"
	  by (auto simp add: outstanding_refs_conv)
	from takeWhile_dropWhile_real_prefix 
	[OF r_in, of  "(Not  is_volatile_Writesb)", simplified, OF volatile_r] 
	obtain a' v' sb'' sop' A' L' R' W' where
	  sb_split: "sb = takeWhile (Not  is_volatile_Writesb) sb @ Writesb True a' sop' v' A' L' R' W'# sb''" 
	  and
	  drop: "dropWhile (Not  is_volatile_Writesb) sb = Writesb True a' sop' v' A' L' R' W'# sb''"
	  apply (auto)
    subgoal for y ys
	  apply (case_tac y)
	  apply auto
	  done
	  done
	from drop suspends have suspends: "suspends = Writesb True a' sop' v' A' L' R' W'# sb''"
	  by simp


	have "(ts, m, 𝒮) d* (ts, m, 𝒮)" by auto

	moreover

	from flush_all_until_volatile_write_Read_commute [OF i_bound tssb_i 
	  [simplified "issb"] ]

	have flush_commute: "flush_all_until_volatile_write
             (tssb[i := (psb,issb', θsb(t  v), sb @ [Readsb volatile a t v], 𝒟sb, 𝒪sb, sb)]) msb =
             flush_all_until_volatile_write tssb msb".

	have "Writesb True a' sop' v' A' L' R' W' set sb"
	  by (subst sb_split) auto
	
	from dropWhile_append1 [OF this, of "(Not  is_volatile_Writesb)"]
	have drop_app_comm:
	  "(dropWhile (Not  is_volatile_Writesb) (sb @ [Readsb volatile a t v])) =
                dropWhile (Not  is_volatile_Writesb) sb @ [Readsb volatile a t v]"
	  by simp

	from load_tmps_fresh [OF i_bound tssb_i]
	have "t  dom θsb"
	  by (auto simp add: "issb")
	then have tmps_commute: 
	  "θsb |` (dom θsb - read_tmps sb'') =
          θsb |` (dom θsb - insert t (read_tmps sb''))"
	  apply -
	  apply (rule ext)
	  apply auto
	  done

	from 𝒟
	have 𝒟': "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb (sb@[Readsb volatile a t v])   {})"
	  by (auto simp: outstanding_refs_append)

	have "(tssb',msb,𝒮sb)  (ts,m,𝒮)"
	  apply (rule sim_config.intros) 
	  apply    (simp add: m flush_commute tssb' 𝒪sb' ℛsb' θsb' sb' 𝒟sb' )
	  using   share_all_until_volatile_write_Read_commute [OF i_bound tssb_i [simplified issb]]
	  apply   (simp add: 𝒮 𝒮sb' tssb' sb' 𝒪sb' ℛsb' θsb')
	  using  leq
	  apply  (simp add: tssb')
	  using i_bound i_bound' ts_sim ts_i is_sim 𝒟' 
	  apply (clarsimp simp add: Let_def nth_list_update is_sim drop_app_comm 
	    read_tmps_append suspends prog_instrs_append_Readsb instrs_append_Readsb 
	    hd_prog_append_Readsb
	    drop "issb" tssb' sb' 𝒪sb' ℛsb' θsb' 𝒟sb' acquired_append takeWhile_append1 [OF r_in] volatile_r 
	    split: if_split_asm)
	  apply (simp add: drop tmps_commute)+
	  done

	ultimately show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_dd'
	    valid_sops' load_tmps_fresh' enough_flushs' 
	    valid_program_history' valid' msb' 𝒮sb' 
	  by (auto simp del: fun_upd_apply )
      qed
    next
      case (SBHReadUnbuffered a volatile t)
      then obtain 
	"issb": "issb = Read volatile a t # issb'" and
	𝒪sb': "𝒪sb'=𝒪sb" andsb': "sb'=sb" and
	θsb': "θsb' = θsb(t(msb a))" and
	sb': "sb'=sb@[Readsb volatile a t (msb a)]" and
	msb': "msb' = msb" and
	𝒮sb': "𝒮sb'=𝒮sb" and 
	𝒟sb': "𝒟sb'=𝒟sb" and
	buf_None: "buffered_val sb a = None" 

	by auto


      from safe_memop_flush_sb [simplified issb]
      obtain access_cond': "a  acquired True sb 𝒪sb  
	a  read_only (share ?drop_sb 𝒮)  (volatile  a  dom (share ?drop_sb 𝒮))" and
	volatile_clean: "volatile  ¬ 𝒟sb" and
        rels_cond: "j < length ts. ij  released (ts!j) a  Some False" and
        rels_nv_cond: "¬volatile  (j < length ts. ij  a  dom (released (ts!j)))"
	by cases auto

      from clean_no_outstanding_volatile_Writesb [OF i_bound tssb_i] volatile_clean
      have volatile_cond: "volatile  outstanding_refs is_volatile_Writesb sb ={}"
	by auto

      {
	fix j pj "issbj" 𝒪j j 𝒟sbj θsbj sbj
	assume j_bound: "j < length tssb"
	assume neq_i_j: "i  j"
	assume jth: "tssb!j = (pj,issbj, θsbj, sbj, 𝒟sbj, 𝒪j,j)"
	assume non_vol: "¬ volatile"
	have "a  𝒪j  all_acquired sbj"
	proof 
	  assume a_j: "a  𝒪j  all_acquired sbj"
	  let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	  let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"


          from ts_sim [rule_format, OF j_bound] jth
	  obtain suspendsj "isj" 𝒟j where
	    suspendsj: "suspendsj = ?drop_sbj" and
	    isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	    𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
	    tsj: "ts!j = (hd_prog pj suspendsj, isj, 
	    θsbj |` (dom θsbj - read_tmps suspendsj),(), 
	    𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	    by (auto simp add: Let_def)
	    

	  from a_j ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth]
	  have a_notin_sb: "a  𝒪sb  all_acquired sb"
	    by auto
	  with acquired_all_acquired [of True sb 𝒪sb]
	  have a_not_acq: "a  acquired True sb 𝒪sb" by blast
	  with access_cond' non_vol
	  have a_ro: "a  read_only (share ?drop_sb 𝒮)"
	    by auto
          from read_only_share_unowned_in [OF weak_consis_drop a_ro] a_notin_sb
            acquired_all_acquired [of True ?take_sb 𝒪sb]
            all_acquired_append [of ?take_sb ?drop_sb]
          have a_ro_shared: "a  read_only 𝒮"
            by auto

          from rels_nv_cond [rule_format, OF non_vol j_bound [simplified leq] neq_i_j] tsj
          have "a  dom (release ?take_sbj (dom (𝒮sb)) j)"
            by auto
          with dom_release_takeWhile [of sbj "(dom (𝒮sb))" j]
          obtain
            a_relsj: "a  dom j" and
            a_sharedj: "a  all_shared ?take_sbj"
            by auto
          
          
          have "a  ((λ(_, _, _, sb, _, _, _). all_shared (takeWhile (Not  is_volatile_Writesb) sb)) `
                 set tssb)"
          proof -
            {
              fix k pk "isk" θk sbk 𝒟k 𝒪k k 
              assume k_bound: "k < length tssb" 
              assume ts_k: "tssb ! k = (pk,isk,θk,sbk,𝒟k,𝒪k,k)" 
              assume a_in: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sbk)"
              have False
              proof (cases "k=j")
                case True with a_sharedj jth ts_k a_in show False by auto
              next
                case False
                from ownership_distinct [OF j_bound k_bound False [symmetric] jth ts_k] a_j
                have "a  (𝒪k  all_acquired sbk)" by auto
                with all_shared_acquired_or_owned [OF sharing_consis [OF k_bound ts_k]] a_in
                show False 
                using all_acquired_append [of "takeWhile (Not  is_volatile_Writesb) sbk" 
                  "dropWhile (Not  is_volatile_Writesb) sbk"] 
                  all_shared_append [of "takeWhile (Not  is_volatile_Writesb) sbk" 
                  "dropWhile (Not  is_volatile_Writesb) sbk"] by auto 
              qed
            }
            thus ?thesis by (fastforce simp add: in_set_conv_nth)
          qed
          with a_ro_shared
            read_only_shared_all_until_volatile_write_subset' [of tssb 𝒮sb]
          have a_ro_sharedsb: "a  read_only 𝒮sb"
            by (auto simp add: 𝒮)
          
	  with read_only_unowned [OF j_bound jth]
	  have a_notin_owns_j: "a  𝒪j"
	    by auto


	  have own_dist: "ownership_distinct tssb" by fact
	  have share_consis: "sharing_consis 𝒮sb tssb" by fact
	  from sharing_consistent_share_all_until_volatile_write [OF own_dist share_consis i_bound tssb_i]
	  have consis': "sharing_consistent 𝒮 (acquired True ?take_sb 𝒪sb) ?drop_sb"
	    by (simp add: 𝒮)
          from  share_all_until_volatile_write_thread_local [OF own_dist share_consis j_bound jth a_j] a_ro_shared
          have a_ro_take: "a  read_only (share ?take_sbj 𝒮sb)"
            by (auto simp add: domIff 𝒮 read_only_def)
          from sharing_consis [OF j_bound jth]
          have "sharing_consistent 𝒮sb 𝒪j sbj".
          from sharing_consistent_weak_sharing_consistent [OF this] weak_sharing_consistent_append [of 𝒪j ?take_sbj ?drop_sbj]
          have weak_consis_drop:"weak_sharing_consistent 𝒪j ?take_sbj"
            by auto
          from read_only_share_acquired_all_shared [OF this read_only_unowned [OF j_bound jth] a_ro_take ] a_notin_owns_j a_sharedj
          have "a  all_acquired ?take_sbj"
            by auto
	  with a_j a_notin_owns_j
	  have a_drop: "a  all_acquired ?drop_sbj"
	    using all_acquired_append [of ?take_sbj ?drop_sbj]
	    by simp
	  

	  from i_bound j_bound leq have j_bound_ts': "j < length ?ts'"
	    by auto

	  note conflict_drop = a_drop [simplified suspendsj [symmetric]]
	  from split_all_acquired_in [OF conflict_drop]
	    (* FIXME: exract common parts *)
	  show False
	  proof 
	    assume "sop a' v ys zs A L R W. 
              (suspendsj = ys @ Writesb True a' sop v A L R W# zs)  a  A"
	    then 
	    obtain a' sop' v' ys zs A' L' R' W' where
	      split_suspendsj: "suspendsj = ys @ Writesb True a' sop' v' A' L' R' W'# zs" 
	      (is "suspendsj = ?suspends") and
		a_A': "a  A'"
	      by blast

	    from sharing_consis [OF j_bound jth]
	    have "sharing_consistent 𝒮sb 𝒪j sbj".
	    then have A'_R': "A'  R' = {}" 
	      by (simp add: sharing_consistent_append [of _ _ ?take_sbj ?drop_sbj, simplified] 
		suspendsj [symmetric] split_suspendsj sharing_consistent_append)
	    from valid_program_history [OF j_bound jth] 
	    have "causal_program_history issbj sbj".
	    then have cph: "causal_program_history issbj ?suspends"
	      apply -
	      apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply (simp add: split_suspendsj)
	      done

	    from tsj neq_i_j j_bound 
	    have ts'_j: "?ts'!j = (hd_prog pj suspendsj, isj,
	      θsbj |` (dom θsbj - read_tmps suspendsj),(), 
	      𝒟j, acquired True ?take_sbj 𝒪j, release ?take_sbj (dom 𝒮sb) j)"
	      by auto
	    from valid_last_prog [OF j_bound jth] have last_prog: "last_prog pj sbj = pj".
	    then
	    have lp: "last_prog pj suspendsj = pj"
	      apply -
	      apply (rule last_prog_same_append [where sb="?take_sbj"])
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	    from valid_reads [OF j_bound jth]
	    have reads_consis_j: "reads_consistent False 𝒪j msb sbj".
	    from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb j_bound 
	      jth reads_consis_j]
	    have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
	      by (simp add: m suspendsj)


	    from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j tssb_i jth]
	    have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
	      by (simp add: suspendsj)
	    from reads_consistent_flush_independent [OF this reads_consis_m_j]
	    have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	      (flush ?drop_sb m) suspendsj".
	    hence reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	      (flush ?drop_sb m) (ys@[Writesb True a' sop' v' A' L' R' W'])"
	      by (simp add: split_suspendsj reads_consistent_append)

	    from valid_write_sops [OF j_bound jth]
	    have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
	      valid_sops_drop: "sopwrite_sops (ys@[Writesb True a' sop' v' A' L' R' W']). valid_sop sop"
	      apply (simp only: write_sops_append)
	      apply auto
	      done

	    from read_tmps_distinct [OF j_bound jth]
	    have "distinct_read_tmps (?take_sbj@suspendsj)"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain 
	      read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
	      distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
	      apply (simp only: split_suspendsj [symmetric] suspendsj) 
	      apply (simp only: distinct_read_tmps_append)
	      done

	    from valid_history [OF j_bound jth]
	    have h_consis: 
	      "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	    
	    have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	    proof -
	      from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		by simp
	      from last_prog_hd_prog_append' [OF h_consis] this
	      have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		by (simp only: split_suspendsj [symmetric] suspendsj) 
	      moreover 
	      have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		last_prog (hd_prog pj suspendsj) ?take_sbj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		by (rule last_prog_hd_prog_append)
	      ultimately show ?thesis
		by (simp add: split_suspendsj [symmetric] suspendsj) 
	    qed

	    from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
	      h_consis] last_prog_hd_prog
	    have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    from reads_consistent_drop_volatile_writes_no_volatile_reads  
	    [OF reads_consis_j] 
	    have no_vol_read: "outstanding_refs is_volatile_Readsb 
	      (ys@[Writesb True a' sop' v' A' L' R' W']) = {}"
	      by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )

	    have acq_simp:
	      "acquired True (ys @ [Writesb True a' sop' v' A' L' R' W']) 
              (acquired True ?take_sbj 𝒪j) = 
              acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R'"
	      by (simp add: acquired_append)

	    from flush_store_buffer_append [where sb="ys@[Writesb True a' sop' v' A' L' R' W']" and sb'="zs", simplified,
	      OF j_bound_ts' isj [simplified split_suspendsj] cph [simplified suspendsj]
	      ts'_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys 
	      hist_consis' [simplified split_suspendsj] valid_sops_drop 
	      distinct_read_tmps_drop [simplified split_suspendsj] 
	      no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="share ?drop_sb 𝒮"]

	    obtain isj' j' where
	      isj': "instrs zs @ issbj = isj' @ prog_instrs zs" and
	      steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮)  d* 
	      (?ts'[j:=(last_prog
              (hd_prog pj (Writesb True a' sop' v' A' L' R' W'# zs)) (ys@[Writesb True a' sop' v' A' L' R' W']),
              isj',
              θsbj |` (dom θsbj - read_tmps zs),
              (), True, acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R',j')],
              flush (ys@[Writesb True a' sop' v' A' L' R' W']) (flush ?drop_sb m),
              share (ys@[Writesb True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
	      (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
              by (auto simp add: acquired_append outstanding_refs_append)

	    from i_bound' have i_bound_ys: "i < length ?ts_ys"
	      by auto

	    from i_bound' neq_i_j 
	    have ts_ys_i: "?ts_ys!i = (psb, issb, θsb,(), 
	      𝒟sb, acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb)"
	      by simp
	    note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
	    
	    from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	    have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	    from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified issb] non_vol a_not_acq
	    have "a  read_only (share (ys@[Writesb True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
	      apply cases
	      apply (auto simp add: Let_def issb)
	      done

	    with a_A'
	    show False
	      by (simp add: share_append in_read_only_convs)
	  next
	    assume "A L R W ys zs. suspendsj = ys @ Ghostsb A L R W # zs  a  A"
	    then 
	    obtain A' L' R' W' ys zs where
	      split_suspendsj: "suspendsj = ys @ Ghostsb A' L' R' W'# zs" 
	      (is "suspendsj = ?suspends") and
		a_A': "a  A'"
	      by blast

	    from valid_program_history [OF j_bound jth] 
	    have "causal_program_history issbj sbj".
	    then have cph: "causal_program_history issbj ?suspends"
	      apply -
	      apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply (simp add: split_suspendsj)
	      done

	    from tsj neq_i_j j_bound 
	    have ts'_j: "?ts'!j = (hd_prog pj suspendsj, isj,
	      θsbj |` (dom θsbj - read_tmps suspendsj),(), 
	      𝒟j, acquired True ?take_sbj 𝒪j, release ?take_sbj (dom 𝒮sb) j)"
	      by auto
	    from valid_last_prog [OF j_bound jth] have last_prog: "last_prog pj sbj = pj".
	    then
	    have lp: "last_prog pj suspendsj = pj"
	      apply -
	      apply (rule last_prog_same_append [where sb="?take_sbj"])
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done


	    from valid_reads [OF j_bound jth]
	    have reads_consis_j: "reads_consistent False 𝒪j msb sbj".
	    from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb j_bound 
	      jth reads_consis_j]
	    have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
	      by (simp add: m suspendsj)

	    from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j tssb_i jth]
	    have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
	      by (simp add: suspendsj)
	    from reads_consistent_flush_independent [OF this reads_consis_m_j]
	    have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	      (flush ?drop_sb m) suspendsj".

	    hence reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  
	      (flush ?drop_sb m) (ys@[Ghostsb A' L' R' W'])"
	      by (simp add: split_suspendsj reads_consistent_append)
	    from valid_write_sops [OF j_bound jth]
	    have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
	      valid_sops_drop: "sopwrite_sops (ys@[Ghostsb A' L' R' W']). valid_sop sop"
	      apply (simp only: write_sops_append)
	      apply auto
	      done

	    from read_tmps_distinct [OF j_bound jth]
	    have "distinct_read_tmps (?take_sbj@suspendsj)"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain 
	      read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
	      distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
	      apply (simp only: split_suspendsj [symmetric] suspendsj) 
	      apply (simp only: distinct_read_tmps_append)
	      done

	    from valid_history [OF j_bound jth]
	    have h_consis: 
	      "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	    
	    have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	    proof -
	      from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		by simp
	      from last_prog_hd_prog_append' [OF h_consis] this
	      have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		by (simp only: split_suspendsj [symmetric] suspendsj) 
	      moreover 
	      have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		last_prog (hd_prog pj suspendsj) ?take_sbj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		by (rule last_prog_hd_prog_append)
	      ultimately show ?thesis
		by (simp add: split_suspendsj [symmetric] suspendsj) 
	    qed

	    from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
	      h_consis] last_prog_hd_prog
	    have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    from reads_consistent_drop_volatile_writes_no_volatile_reads  
	    [OF reads_consis_j] 
	    have no_vol_read: "outstanding_refs is_volatile_Readsb 
	      (ys@[Ghostsb A' L' R' W']) = {}"
	      by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )

	    have acq_simp:
	      "acquired True (ys @ [Ghostsb A' L' R' W']) 
              (acquired True ?take_sbj 𝒪j) = 
              acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R'"
	      by (simp add: acquired_append)

	    from flush_store_buffer_append [where sb="ys@[Ghostsb A' L' R' W']" and sb'="zs", simplified,
	      OF j_bound_ts' isj [simplified split_suspendsj] cph [simplified suspendsj]
	      ts'_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys 
	      hist_consis' [simplified split_suspendsj] valid_sops_drop 
	      distinct_read_tmps_drop [simplified split_suspendsj] 
	      no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="share ?drop_sb 𝒮"]
	    obtain isj' j' where
	      isj': "instrs zs @ issbj = isj' @ prog_instrs zs" and
	      steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮)  d* 
	      (?ts'[j:=(last_prog
              (hd_prog pj (Ghostsb A' L' R' W'# zs)) (ys@[Ghostsb A' L' R' W']),
              isj',
              θsbj |` (dom θsbj - read_tmps zs),
              (),
              𝒟j  outstanding_refs is_volatile_Writesb (ys @ [Ghostsb A' L' R' W'])  {}, acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R',j')],
              flush (ys@[Ghostsb A' L' R' W']) (flush ?drop_sb m),
              share (ys@[Ghostsb A' L' R' W']) (share ?drop_sb 𝒮))"
	      (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
              by (auto simp add: acquired_append)

	    from i_bound' have i_bound_ys: "i < length ?ts_ys"
	      by auto

	    from i_bound' neq_i_j 
	    have ts_ys_i: "?ts_ys!i = (psb, issb,θsb,(), 
	      𝒟sb, acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb)"
	      by simp
	    note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
	    
	    from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	    have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	    from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified issb] non_vol a_not_acq
	    have "a  read_only (share (ys@[Ghostsb A' L' R' W']) (share ?drop_sb 𝒮))"
	      apply cases
	      apply (auto simp add: Let_def issb)
	      done

	    with a_A'
	    show False
	      by (simp add: share_append in_read_only_convs)
	  qed
	qed
      }
      note non_volatile_unowned_others = this

            {
        assume a_in: "a  read_only (share (dropWhile (Not  is_volatile_Writesb) sb) 𝒮)"
        assume nv: "¬ volatile"
        have "a  read_only (share sb 𝒮sb)"
        proof (cases "a  𝒪sb  all_acquired sb")
          case True
          from share_all_until_volatile_write_thread_local' [OF ownership_distinct_tssb 
            sharing_consis_tssb i_bound tssb_i True] True a_in
          show ?thesis
            by (simp add: 𝒮 read_only_def)
        next
          case False
          from read_only_share_unowned [OF weak_consis_drop _ a_in] False 
            acquired_all_acquired [of True ?take_sb 𝒪sb] all_acquired_append [of ?take_sb ?drop_sb]
          have a_ro_shared: "a  read_only 𝒮"
            by auto
          have "a  ((λ(_, _, _, sb, _, _, _).
               all_shared (takeWhile (Not  is_volatile_Writesb) sb)) ` set tssb)"
          proof -
            {
              fix k pk "isk" θk sbk 𝒟k 𝒪k k 
              assume k_bound: "k < length tssb" 
              assume ts_k: "tssb ! k = (pk,isk,θk,sbk,𝒟k,𝒪k,k)" 
              assume a_in: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sbk)"
              have False
              proof (cases "k=i")
                case True with False tssb_i ts_k a_in 
                  all_shared_acquired_or_owned [OF sharing_consis [OF k_bound ts_k]]     
                  all_shared_append [of "takeWhile (Not  is_volatile_Writesb) sbk" 
                  "dropWhile (Not  is_volatile_Writesb) sbk"] show False by auto
              next
                case False
                from rels_nv_cond [rule_format, OF nv k_bound [simplified leq] False [symmetric] ] 
                ts_sim [rule_format, OF k_bound] ts_k
                have "a  dom (release (takeWhile (Not  is_volatile_Writesb) sbk) (dom (𝒮sb)) k)"
                  by (auto simp add: Let_def)
                with dom_release_takeWhile [of sbk "(dom (𝒮sb))" k]
                obtain
                  a_relsj: "a  dom k" and
                  a_sharedj: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sbk)"
                  by auto
                with False a_in show ?thesis 
                  by auto
             qed
           }      
           thus ?thesis 
             by (auto simp add: in_set_conv_nth)
          qed
          with read_only_shared_all_until_volatile_write_subset' [of tssb 𝒮sb] a_ro_shared
          have "a  read_only 𝒮sb"
            by (auto simp add: 𝒮)

          from read_only_share_unowned' [OF weak_consis_sb read_only_unowned [OF i_bound tssb_i] False  this]
          show ?thesis .
        qed
      } note non_vol_ro_reduction = this

      have valid_own': "valid_ownership 𝒮sb' tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	proof (cases volatile)
	  case False
	  from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i]
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb sb".
	  then

	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb (sb@[Readsb False a t (msb a)])"
	    using access_cond' False non_vol_ro_reduction
	    by (auto simp add: non_volatile_owned_or_read_only_append)

	  from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	  show ?thesis by (auto simp add: False tssb' sb' 𝒪sb' 𝒮sb')
	next
	  case True
	  from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i]  
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb sb".
	  then
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb (sb@[Readsb True a t (msb a)])"
	    using True
	    by (simp add: non_volatile_owned_or_read_only_append)
	  from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	  show ?thesis by (auto simp add: True tssb' sb' 𝒪sb' 𝒮sb')
	qed
      next
	show "outstanding_volatile_writes_unowned_by_others tssb'"
	proof -
	  have out: "outstanding_refs is_volatile_Writesb (sb @ [Readsb volatile a t (msb a)])  
            outstanding_refs is_volatile_Writesb sb"
	    by (auto simp add: outstanding_refs_append)
	  have "all_acquired (sb @ [Readsb volatile a t (msb a)])  all_acquired sb"
	    by (auto simp add: all_acquired_append)
	  from outstanding_volatile_writes_unowned_by_others_store_buffer 
	  [OF i_bound tssb_i out this]
	  show ?thesis by (simp add: tssb' sb' 𝒪sb')
	qed
      next
	show "read_only_reads_unowned tssb'"
	proof (cases volatile)
	  case True
	  have r: "read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) 
	            (sb @ [Readsb volatile a t (msb a)])) 𝒪sb)
                    (dropWhile (Not  is_volatile_Writesb) (sb @ [Readsb volatile a t (msb a)]))
                 read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪sb)
                    (dropWhile (Not  is_volatile_Writesb) sb)"
	    apply (case_tac "outstanding_refs (is_volatile_Writesb) sb = {}")
	    apply (simp_all add: outstanding_vol_write_take_drop_appends
	    acquired_append read_only_reads_append True)
	    done

	  have "𝒪sb  all_acquired (sb @ [Readsb volatile a t (msb a)])  𝒪sb  all_acquired sb"
	    by (simp add: all_acquired_append)

	 
	  from  read_only_reads_unowned_nth_update [OF i_bound tssb_i r this]
	  show ?thesis
	    by (simp add: tssb' 𝒪sb' sb')
	next
	  case False
	  show ?thesis
	  proof (unfold_locales)
	    fix n m
	    fix pn "isn" 𝒪n n 𝒟n θn sbn pm "ism" 𝒪m m 𝒟m θm sbm
	    assume n_bound: "n < length tssb'"
	    and m_bound: "m < length tssb'"
	    and neq_n_m: "nm"
	    and nth: "tssb'!n = (pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
	    and mth: "tssb'!m =(pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
	    from n_bound have n_bound': "n < length tssb" by (simp add: tssb')
	    from m_bound have m_bound': "m < length tssb" by (simp add: tssb')

	    have acq_eq: "(𝒪sb'  all_acquired sb') = (𝒪sb  all_acquired sb)"
	      by (simp add: all_acquired_append sb' 𝒪sb')	      

	    show "(𝒪m  all_acquired sbm) 
              read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbn) 𝒪n)
              (dropWhile (Not  is_volatile_Writesb) sbn) =
              {}"
	    proof (cases "m=i")
	      case True
	      with neq_n_m have neq_n_i: "ni"
		by auto
		
	      with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
		by (auto simp add: tssb')
	      note read_only_reads_unowned [OF n_bound' i_bound  neq_n_i nth' tssb_i]
	      moreover
	      note acq_eq
	      ultimately show ?thesis
		using True tssb_i nth mth n_bound' m_bound'
		by (simp add: tssb')
	    next
	      case False
	      note neq_m_i = this
	      with m_bound mth i_bound have mth': "tssb!m = (pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
		by (auto simp add: tssb')
	      show ?thesis
	      proof (cases "n=i")
		case True
		note read_only_reads_unowned [OF i_bound m_bound' neq_m_i [symmetric] tssb_i mth']
		moreover 
		note acq_eq
		moreover
		note non_volatile_unowned_others [OF m_bound' neq_m_i [symmetric] mth']
		ultimately show ?thesis
		  using True tssb_i nth mth n_bound' m_bound' neq_m_i
		  apply (case_tac "outstanding_refs (is_volatile_Writesb) sb = {}")
		  apply (clarsimp simp add: outstanding_vol_write_take_drop_appends
		    acquired_append read_only_reads_append tssb' sb' 𝒪sb')+
		  done
	      next
		case False
		with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
		  by (auto simp add: tssb')
		from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m  nth' mth'] False neq_m_i
		show ?thesis 
		  by (clarsimp)
	      qed
	    qed
	  qed
	qed
	show "ownership_distinct tssb'"
	proof -
	  have "all_acquired (sb @ [Readsb volatile a t (msb a)])  all_acquired sb"
	    by (auto simp add: all_acquired_append)
	  from ownership_distinct_instructions_read_value_store_buffer_independent 
	  [OF i_bound tssb_i this]
	  show ?thesis by (simp add: tssb' sb' 𝒪sb')
	qed
      qed


      have valid_hist': "valid_history program_step tssb'"
      proof -
	from valid_history [OF i_bound tssb_i]
	have hcons: "history_consistent θsb (hd_prog psb sb) sb".
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i]
	have t_notin_reads: "t  read_tmps sb"
	  by (auto simp add: "issb")
	from load_tmps_write_tmps_distinct [OF i_bound tssb_i]
	have t_notin_writes: "t  (fst ` write_sops sb )"
	  by (auto simp add: "issb")

	from valid_write_sops [OF i_bound tssb_i]
	have valid_sops: "sop  write_sops sb. valid_sop sop"
	  by auto
	from load_tmps_fresh [OF i_bound tssb_i]
	have t_fresh: "t  dom θsb"
	  using "issb"
	  by simp

	from valid_implies_valid_prog_hd [OF i_bound tssb_i valid]
	have "history_consistent (θsb(tmsb a)) 
	       (hd_prog psb (sb@ [Readsb volatile a t (msb a)])) 
               (sb@ [Readsb volatile a t (msb a)])"
	  using t_notin_writes valid_sops t_fresh hcons
	  apply -
	  apply (rule history_consistent_appendI)
	  apply (auto simp add: hd_prog_append_Readsb)
	  done

	from valid_history_nth_update [OF i_bound this]
	show ?thesis
	  by (auto simp add: tssb' sb' 𝒪sb' θsb')
      qed

      from 
	reads_consistent_unbuffered_snoc [OF buf_None refl valid_reads [OF i_bound tssb_i] volatile_cond ]    
      have reads_consis': "reads_consistent False 𝒪sb msb (sb @ [Readsb volatile a t (msb a)])"
	by (simp split: if_split_asm)

      from valid_reads_nth_update [OF i_bound this]
      have valid_reads': "valid_reads msb tssb'" by (simp add: tssb' sb' 𝒪sb')

      have valid_sharing': "valid_sharing 𝒮sb' tssb'"
      proof (intro_locales)	
	from outstanding_non_volatile_writes_unshared [OF i_bound tssb_i]
	have "non_volatile_writes_unshared 𝒮sb (sb @ [Readsb volatile a t (msb a)])"
	  by (auto simp add: non_volatile_writes_unshared_append)
	from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
	show "outstanding_non_volatile_writes_unshared 𝒮sb' tssb'"
	  by (simp add: tssb' sb' 𝒮sb')
      next
	from sharing_consis [OF i_bound tssb_i]
	have "sharing_consistent 𝒮sb 𝒪sb sb".
	then
	have "sharing_consistent 𝒮sb 𝒪sb (sb @ [Readsb volatile a t (msb a)])"
	  by (simp add:  sharing_consistent_append)
	from sharing_consis_nth_update [OF i_bound this]
	show "sharing_consis 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒪sb' sb' 𝒮sb')
      next
	note read_only_unowned [OF i_bound tssb_i]
	from read_only_unowned_nth_update [OF i_bound this]
	show "read_only_unowned 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' sb' 𝒪sb')
      next
	from unowned_shared_nth_update [OF i_bound tssb_i subset_refl]
	show "unowned_shared 𝒮sb' tssb'" by (simp add: tssb' 𝒪sb' 𝒮sb')
      next
	from no_outstanding_write_to_read_only_memory [OF i_bound tssb_i]
	have "no_write_to_read_only_memory 𝒮sb sb".
	hence "no_write_to_read_only_memory 𝒮sb (sb@[Readsb volatile a t (msb a)])"
	  by (simp add: no_write_to_read_only_memory_append)
	from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
	show "no_outstanding_write_to_read_only_memory 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒮sb' sb')
      qed

      have tmps_distinct': "tmps_distinct tssb'"
      proof (intro_locales)
	from load_tmps_distinct [OF i_bound tssb_i]
	have "distinct_load_tmps issb'"
	  by (auto split: instr.splits simp add: issb)
	from load_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_distinct tssb'" by (simp add: tssb')
      next
	from read_tmps_distinct [OF i_bound tssb_i]
	have "distinct_read_tmps sb".
	moreover
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i]
	have "t  read_tmps sb"
	  by (auto simp add: issb)
	ultimately have "distinct_read_tmps (sb @ [Readsb volatile a t (msb a)])"
	  by (auto simp add: distinct_read_tmps_append)
	from read_tmps_distinct_nth_update [OF i_bound this]
	show "read_tmps_distinct tssb'" by (simp add: tssb' sb')
      next
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i] 
          load_tmps_distinct [OF i_bound tssb_i]
	have "load_tmps issb'  read_tmps (sb @ [Readsb volatile a t (msb a)]) = {}"
	  by (clarsimp simp add: read_tmps_append "issb")
	from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_read_tmps_distinct tssb'" by (simp add: tssb' sb')
      qed

      have valid_sops': "valid_sops tssb'"
      proof -
	from valid_store_sops [OF i_bound tssb_i]
	have valid_store_sops': "sopstore_sops issb'. valid_sop sop"
	  by (auto simp add: "issb")
	from valid_write_sops [OF i_bound tssb_i]
	have valid_write_sops': "sopwrite_sops (sb@ [Readsb volatile a t (msb a)]). 
	      valid_sop sop"
	  by (auto simp add: write_sops_append)
	from valid_sops_nth_update [OF i_bound  valid_write_sops' valid_store_sops']
	show ?thesis by (simp add: tssb' sb')
      qed

      have valid_dd': "valid_data_dependency tssb'"
      proof -
	from data_dependency_consistent_instrs [OF i_bound tssb_i]
	have dd_is: "data_dependency_consistent_instrs (dom θsb') issb'"
	  by (auto simp add: "issb" θsb')
	from load_tmps_write_tmps_distinct [OF i_bound tssb_i]
	have "load_tmps issb'  (fst ` write_sops (sb@ [Readsb volatile a t (msb a)])) = {}"
	  by (auto simp add: write_sops_append "issb")
	from valid_data_dependency_nth_update [OF i_bound dd_is this]
	show ?thesis by (simp add: tssb' sb')
      qed

      have load_tmps_fresh': "load_tmps_fresh tssb'"
      proof -
	from load_tmps_fresh [OF i_bound tssb_i] 
	have "load_tmps (Read volatile a t # issb')  dom θsb = {}"
	  by (simp add: "issb")
	moreover
	from load_tmps_distinct [OF i_bound tssb_i] have "t  load_tmps issb'"
	  by (auto simp add: "issb")
	ultimately have "load_tmps issb'  dom (θsb(t  (msb a))) = {}"
	  by auto
	from load_tmps_fresh_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' θsb')
      qed

      have enough_flushs': "enough_flushs tssb'"
      proof -
	from clean_no_outstanding_volatile_Writesb [OF i_bound tssb_i]
	have "¬ 𝒟sb  outstanding_refs is_volatile_Writesb (sb@[Readsb volatile a t (msb a)]) = {}"
	  by (auto simp add: outstanding_refs_append )
	from enough_flushs_nth_update [OF i_bound this]
	show ?thesis
	  by (simp add: tssb' sb' 𝒟sb')
      qed

      have valid_program_history': "valid_program_history tssb'"
      proof -	
	from valid_program_history [OF i_bound tssb_i]
	have "causal_program_history issb sb" .
	then have causal': "causal_program_history issb' (sb@[Readsb volatile a t (msb a)])"
	  by (auto simp: causal_program_history_Read  "issb")
	from valid_last_prog [OF i_bound tssb_i]
	have "last_prog psb sb = psb".
	hence "last_prog psb (sb @ [Readsb volatile a t (msb a)]) = psb"
	  by (simp add: last_prog_append_Readsb)
	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb' sb')
      qed

      show ?thesis
      proof (cases "outstanding_refs is_volatile_Writesb sb = {}")
	case True 

	from True have flush_all: "takeWhile (Not  is_volatile_Writesb) sb = sb"
	  by (auto simp add: outstanding_refs_conv )

	from True have suspend_nothing: "dropWhile (Not  is_volatile_Writesb) sb = []"
	  by (auto simp add: outstanding_refs_conv)

	hence suspends_empty: "suspends = []"
	  by (simp add: suspends)
	from suspends_empty is_sim have "is": "is = Read volatile a t # issb'"
	  by (simp add: "issb")
	with suspends_empty ts_i 
	have ts_i: "ts!i = (psb, Read volatile a t # issb', θsb,(), 
          𝒟, acquired True ?take_sb 𝒪sb, release ?take_sb (dom 𝒮sb) sb)"
	  by simp

	from direct_memop_step.Read
	have "(Read volatile a t # issb',θsb, (), m, 
            𝒟, acquired True ?take_sb 𝒪sb,release ?take_sb (dom 𝒮sb) sb,𝒮)  
          (issb', θsb(t  m a), (), m, 𝒟, acquired True ?take_sb 𝒪sb,
           release ?take_sb (dom 𝒮sb) sb, 𝒮)".
	from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
	have "(ts, m, 𝒮) d (ts[i := (psb, issb', θsb(t  m a), (), 
	   𝒟, acquired True ?take_sb 𝒪sb,release ?take_sb (dom 𝒮sb) sb)], m, 𝒮)".

	moreover
	
	from flush_all_until_volatile_write_Read_commute [OF i_bound tssb_i [simplified "issb"] ]
	have flush_commute: "flush_all_until_volatile_write
          (tssb[i := (psb,issb', θsb(tmsb a), sb @ [Readsb volatile a t (msb a)], 𝒟sb, 𝒪sb,sb)]) 
           msb =
          flush_all_until_volatile_write tssb msb".
	
	have "flush_all_until_volatile_write tssb msb a = msb a"
	proof -
          have "j < length tssb. i  j 
                  (let (_,_,_,sbj,_,_,_) = tssb!j 
                  in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))"
	  proof -
	    {
	      fix j pj "isj" 𝒪j j 𝒟j acqj xsj sbj
	      assume j_bound: "j < length tssb"
	      assume neq_i_j: "i  j"
	      assume jth: "tssb!j = (pj,isj, xsj, sbj, 𝒟j, 𝒪j, j)"
	      have "a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	      proof 
		let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
		let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"
		assume a_in: "a  outstanding_refs is_non_volatile_Writesb ?take_sbj"
		with outstanding_refs_takeWhile [where P'= "Not  is_volatile_Writesb"]
		have a_in': "a  outstanding_refs is_non_volatile_Writesb sbj"
		  by auto
		with non_volatile_owned_or_read_only_outstanding_non_volatile_writes 
		[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]]
		have j_owns: "a  𝒪j  all_acquired sbj"
		  by auto
		with ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth]
		have a_not_owns: "a  𝒪sb  all_acquired sb"
		  by blast
		
		from non_volatile_owned_or_read_only_append [of False 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
		  outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]
		have "non_volatile_owned_or_read_only False 𝒮sb 𝒪j ?take_sbj"
		  by simp
		from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF this] a_in
		have j_owns_drop: "a  𝒪j  all_acquired ?take_sbj"
		  by auto
		
                from rels_cond [rule_format, OF j_bound [simplified leq] neq_i_j] ts_sim [rule_format, OF j_bound] jth
                have no_unsharing:"release ?take_sbj (dom (𝒮sb)) j  a  Some False"
                  by (auto simp add: Let_def)
		{
		  assume "a  acquired True sb 𝒪sb"
		  with acquired_all_acquired_in [OF this] ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth] 
		    j_owns 
		  have False
		    by auto
		}
		moreover
		{
		  assume a_ro: "a  read_only (share ?drop_sb 𝒮)"
                  from read_only_share_unowned_in [OF weak_consis_drop a_ro] a_not_owns
                  acquired_all_acquired [of True ?take_sb 𝒪sb]
                  all_acquired_append [of ?take_sb ?drop_sb]
                  have "a  read_only 𝒮"
                    by auto
                  with share_all_until_volatile_write_thread_local [OF ownership_distinct_tssb sharing_consis_tssb j_bound jth j_owns]
                  have "a  read_only (share ?take_sbj 𝒮sb)"
                    by (auto simp add: read_only_def 𝒮)
                  hence a_dom: "a  dom  (share ?take_sbj 𝒮sb)"
                    by (auto simp add: read_only_def domIff)
                  from outstanding_non_volatile_writes_unshared [OF j_bound jth]
                  non_volatile_writes_unshared_append [of 𝒮sb ?take_sbj ?drop_sbj]
                  have nvw: "non_volatile_writes_unshared 𝒮sb ?take_sbj" by auto
                  from release_not_unshared_no_write_take [OF this no_unsharing a_dom] a_in
                  have False by auto
		}
		moreover
		{
		  assume a_share: "volatile  a  dom (share ?drop_sb 𝒮)"
		  from outstanding_non_volatile_writes_unshared [OF j_bound jth]
		  have "non_volatile_writes_unshared 𝒮sb sbj".
		  with non_volatile_writes_unshared_append [of 𝒮sb "(takeWhile (Not  is_volatile_Writesb) sbj)"
		  "(dropWhile (Not  is_volatile_Writesb) sbj)"]
		  have unshared_take: "non_volatile_writes_unshared 𝒮sb (takeWhile (Not  is_volatile_Writesb) sbj)" 
		    by clarsimp
		
		  from valid_own have own_dist: "ownership_distinct tssb"
		    by (simp add: valid_ownership_def)
		  from valid_sharing have "sharing_consis 𝒮sb tssb"
		    by (simp add: valid_sharing_def)
		  from sharing_consistent_share_all_until_volatile_write [OF own_dist this i_bound tssb_i]
		  have sc: "sharing_consistent 𝒮 (acquired True ?take_sb 𝒪sb) ?drop_sb"
		    by (simp add: 𝒮)
		  from sharing_consistent_share_all_shared 
		  have "dom (share ?drop_sb 𝒮)  dom 𝒮  all_shared ?drop_sb"
		    by auto
		  also from sharing_consistent_all_shared [OF sc]
		  have "  dom 𝒮  acquired True ?take_sb 𝒪sb" by auto
		  also from acquired_all_acquired all_acquired_takeWhile 
		  have "  dom 𝒮  (𝒪sb  all_acquired sb)" by force
		  finally
		  have a_shared: "a  dom 𝒮"
		    using a_share a_not_owns
		    by auto

                  with share_all_until_volatile_write_thread_local [OF ownership_distinct_tssb sharing_consis_tssb j_bound jth j_owns]
                  have a_dom: "a  dom  (share ?take_sbj 𝒮sb)"
                    by (auto simp add: 𝒮 domIff)
                  from release_not_unshared_no_write_take [OF  unshared_take no_unsharing a_dom] a_in
                  have False by auto
		}
		ultimately show False
		  using access_cond'
		  by auto
	      qed
	    }
	    thus ?thesis
	      by (fastforce simp add: Let_def)
	  qed
	  
	  from flush_all_until_volatile_write_buffered_val_conv 
	  [OF True i_bound tssb_i this]
	  show ?thesis
	    by (simp add: buf_None)
	qed
	
	hence m_a: "m a = msb a"
	  by (simp add: m)
	
	have tmps_commute: "θsb(t  (msb a)) = 
	  (θsb |` (dom θsb - {t}))(t  (msb a))"
	  apply (rule ext)
	  apply (auto simp add: restrict_map_def domIff)
	  done

	from suspend_nothing
	have suspend_nothing': "(dropWhile (Not  is_volatile_Writesb) sb') = []"
	  by (simp add: sb')

	from 𝒟
	have 𝒟': "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb (sb@[Readsb volatile a t (msb a)])   {})"
	  by (auto simp: outstanding_refs_append)

	have "(tssb',msb,𝒮sb')  (ts[i := (psb,issb', θsb(tm a),(), 𝒟, acquired True ?take_sb 𝒪sb,release ?take_sb (dom 𝒮sb) sb)], m,𝒮)"
	  apply (rule sim_config.intros) 
	  apply    (simp add: m flush_commute tssb' 𝒪sb' ℛsb' θsb' sb' 𝒟sb' )
	  using   share_all_until_volatile_write_Read_commute [OF i_bound tssb_i [simplified issb]]
	  apply   (simp add: 𝒮 𝒮sb' tssb' sb' 𝒪sb' ℛsb' θsb')
	  using  leq
	  apply  (simp add: tssb')
	  using i_bound i_bound' ts_sim ts_i True 𝒟'
	  apply (clarsimp simp add: Let_def nth_list_update 
	    outstanding_refs_conv m_a  tssb' 𝒪sb' ℛsb' 𝒮sb' θsb' sb' 𝒟sb' suspend_nothing' 
	    flush_all acquired_append release_append
	    split: if_split_asm )
	  apply (rule tmps_commute)
	  done	

	ultimately show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct'
	    valid_sops' valid_dd' load_tmps_fresh' enough_flushs' 
	    valid_program_history' valid'
	    msb' 𝒮sb' 
	  by (auto simp del: fun_upd_apply )
      next
	case False

	then obtain r where r_in: "r  set sb" and volatile_r: "is_volatile_Writesb r"
	  by (auto simp add: outstanding_refs_conv)
	from takeWhile_dropWhile_real_prefix 
	[OF r_in, of  "(Not  is_volatile_Writesb)", simplified, OF volatile_r] 
	obtain a' v' sb'' sop' A' L' R' W' where
	  sb_split: "sb = takeWhile (Not  is_volatile_Writesb) sb @ Writesb True a' sop' v' A' L' R' W'# sb''" 
	  and
	  drop: "dropWhile (Not  is_volatile_Writesb) sb = Writesb True a' sop' v' A' L' R' W'# sb''"
	  apply (auto)
    subgoal for y ys
	  apply (case_tac y)
	  apply auto
	  done
	  done
	from drop suspends have suspends: "suspends = Writesb True a' sop' v' A' L' R' W'# sb''"
	  by simp


	have "(ts, m, 𝒮) d* (ts, m, 𝒮)" by auto

	moreover

	note flush_commute = flush_all_until_volatile_write_Read_commute [OF i_bound tssb_i 
	  [simplified "issb"] ]

	have "Writesb True a' sop' v' A' L' R' W' set sb"
	  by (subst sb_split) auto
	
	from dropWhile_append1 [OF this, of "(Not  is_volatile_Writesb)"]
	have drop_app_comm:
	  "(dropWhile (Not  is_volatile_Writesb) (sb @ [Readsb volatile a t (msb a)])) =
                dropWhile (Not  is_volatile_Writesb) sb @ [Readsb volatile a t (msb a)]"
	  by simp

	from load_tmps_fresh [OF i_bound tssb_i]
	have "t  dom θsb"
	  by (auto simp add: "issb")
	then have tmps_commute: 
	  "θsb |` (dom θsb - read_tmps sb'') =
          θsb |` (dom θsb - insert t (read_tmps sb''))"
	  apply -
	  apply (rule ext)
	  apply auto
	  done

	from 𝒟
	have 𝒟': "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb (sb@[Readsb volatile a t (msb a)])   {})"
	  by (auto simp: outstanding_refs_append)

	have "(tssb',msb,𝒮sb)  (ts,m,𝒮)"
	  apply (rule sim_config.intros) 
	  apply    (simp add: m flush_commute tssb' 𝒪sb' ℛsb' θsb' sb')
	  using   share_all_until_volatile_write_Read_commute [OF i_bound tssb_i [simplified issb]]
	  apply   (simp add: 𝒮 𝒮sb' tssb' sb' 𝒪sb' ℛsb' θsb')
	  using  leq
	  apply  (simp add: tssb')
	  using i_bound i_bound' ts_sim ts_i is_sim 𝒟'
	  apply (clarsimp simp add: Let_def nth_list_update is_sim drop_app_comm 
	    read_tmps_append suspends prog_instrs_append_Readsb instrs_append_Readsb 
	    hd_prog_append_Readsb
	    drop "issb" tssb' sb' 𝒪sb' ℛsb' θsb' 𝒟sb' acquired_append takeWhile_append1 [OF r_in] volatile_r  split: if_split_asm)
	  apply (simp add: drop tmps_commute)+
	  done

	ultimately show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_dd'
	    valid_sops' load_tmps_fresh' enough_flushs' 
	    valid_program_history' valid'
	    msb' 𝒮sb' 
	  by (auto simp del: fun_upd_apply )
      qed
    next
      case (SBHWriteNonVolatile a D f A L R W)
      then obtain 
	"issb": "issb = Write False a (D, f) A L R W# issb'" and
	𝒪sb': "𝒪sb'=𝒪sb" andsb': "sb'=sb" and
	θsb': "θsb' = θsb" and
	𝒟sb': "𝒟sb'=𝒟sb" and
	sb': "sb'=sb@[Writesb False a (D, f) (f θsb) A L R W]" and
	msb': "msb' = msb" and
	𝒮sb': "𝒮sb'=𝒮sb" 
	by auto


      from data_dependency_consistent_instrs [OF i_bound tssb_i]
      have D_tmps: "D  dom θsb" 
	by (simp add: issb)

      from safe_memop_flush_sb [simplified issb]
      obtain a_owned': "a  acquired True sb 𝒪sb" and a_unshared': "a  dom (share ?drop_sb 𝒮)" and
        rels_cond: "j < length ts. ij  a  dom (released (ts!j))"
      (* FIXME: rels_cond unused; maybe remove from safe_delayed *) 
	by cases auto

      from a_owned' acquired_all_acquired
      have a_owned'': "a  𝒪sb  all_acquired sb"
	by auto


      {
	fix j
	fix pj isj 𝒪j j 𝒟j θj sbj
	assume j_bound: "j < length tssb"
	assume tssb_j: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	assume neq_i_j: "i  j"
	have "a  𝒪j  all_acquired sbj"
	proof -
	  from ownership_distinct [OF i_bound j_bound neq_i_j tssb_i tssb_j] a_owned''
	  show ?thesis
	    by auto
	qed
      } note a_unowned_others = this
	  
	    
      have a_unshared: "a  dom (share sb 𝒮sb)"
      proof 
	assume a_share: "a  dom (share sb 𝒮sb)"
	from valid_sharing have "sharing_consis 𝒮sb tssb"
	  by (simp add: valid_sharing_def)
	from in_shared_sb_share_all_until_volatile_write [OF this i_bound tssb_i a_owned'' a_share]
	have "a  dom (share ?drop_sb 𝒮)"
	  by (simp add: 𝒮)
	with a_unshared'
	show False
	  by auto
      qed

(*
      from acquired_owns_shared [OF sharing_consis_drop_sb]
      have "acquired True ?drop_sb 𝒪 ⊆ 𝒪 ∪ 𝒮".
      moreover
      from share_owns_shared [OF sharing_consis_drop_sb]
      have "share ?drop_sb 𝒮 ⊆ 𝒪 ∪ 𝒮".
*)
(*
      obtain a_owned: "a ∈ 𝒪" and a_unshared: "a ∉ 𝒮" 
	by cases auto
*)
      have valid_own': "valid_ownership 𝒮sb' tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	proof -
	  from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i]  
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb sb".
	  
	  with a_owned' 
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb (sb @ [Writesb False a (D,f) (f θsb) A L R W])"
	    by (simp add: non_volatile_owned_or_read_only_append)
	  from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	  show ?thesis by (simp add: tssb' "issb" sb' 𝒪sb' 𝒮sb')
	qed
      next
	show "outstanding_volatile_writes_unowned_by_others tssb'"
	proof -
	  have "outstanding_refs is_volatile_Writesb (sb @ [Writesb False a (D,f) (f θsb) A L R W])  
	    outstanding_refs is_volatile_Writesb sb"
	    by (auto simp add: outstanding_refs_append)
	  from outstanding_volatile_writes_unowned_by_others_store_buffer 
	  [OF i_bound tssb_i this]
	  show ?thesis by (simp add: tssb' "issb" sb' 𝒪sb' all_acquired_append)
	qed
      next
	show "read_only_reads_unowned tssb'"
	proof -
	  have r: "read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) 
	    (sb @ [Writesb False a (D,f) (f θsb) A L R W])) 𝒪sb)
            (dropWhile (Not  is_volatile_Writesb) (sb @ [Writesb False a (D,f) (f θsb) A L R W]))
             
	    read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪sb)
            (dropWhile (Not  is_volatile_Writesb) sb)"
	    apply (case_tac "outstanding_refs (is_volatile_Writesb) sb = {}")
	    apply (simp_all add: outstanding_vol_write_take_drop_appends
	    acquired_append read_only_reads_append )
	    done
	  have "𝒪sb  all_acquired (sb @ [Writesb False a (D,f) (f θsb) A L R W])  𝒪sb  all_acquired sb"
	    by (simp add: all_acquired_append)
	  

	  from read_only_reads_unowned_nth_update [OF i_bound tssb_i r this]
	  show ?thesis
	    by (simp add: tssb' 𝒪sb' sb')
	qed 
      next
	show "ownership_distinct tssb'"
	proof -
	  from ownership_distinct_instructions_read_value_store_buffer_independent 
	  [OF i_bound tssb_i]
	  show ?thesis by (simp add: tssb' "issb" sb' 𝒪sb' all_acquired_append)
	qed
      qed

      have valid_hist': "valid_history program_step tssb'"
      proof -
	from valid_history [OF i_bound tssb_i]
	have "history_consistent θsb (hd_prog psb sb) sb".
	with valid_write_sops [OF i_bound tssb_i] D_tmps 
	  valid_implies_valid_prog_hd [OF i_bound tssb_i valid]
	have "history_consistent θsb (hd_prog psb (sb@[Writesb False a (D,f) (f θsb) A L R W])) 
	       (sb@ [Writesb False a (D,f) (f θsb) A L R W])"
	  apply -
	  apply (rule history_consistent_appendI)
	  apply (auto simp add: hd_prog_append_Writesb)
	  done
	from valid_history_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' "issb" sb' 𝒪sb' θsb')
      qed

      have valid_reads': "valid_reads msb tssb'"
      proof -
	from valid_reads [OF i_bound tssb_i]
	have "reads_consistent False 𝒪sb msb sb" .
	from reads_consistent_snoc_Writesb [OF this]
	have "reads_consistent False 𝒪sb msb (sb @ [Writesb False a (D,f) (f θsb) A L R W])".
	from valid_reads_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' "issb" sb' 𝒪sb' θsb')
      qed

      have valid_sharing': "valid_sharing 𝒮sb' tssb'"
      proof (intro_locales)	
	from outstanding_non_volatile_writes_unshared [OF i_bound tssb_i] a_unshared
	have "non_volatile_writes_unshared 𝒮sb
	      (sb @ [Writesb False a (D,f) (f θsb) A L R W])"
	  by (auto simp add: non_volatile_writes_unshared_append)
	from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
	show "outstanding_non_volatile_writes_unshared 𝒮sb' tssb'"
	  by (simp add: tssb' "issb" sb' 𝒪sb' θsb' 𝒮sb')
      next
	from sharing_consis [OF i_bound tssb_i]
	have "sharing_consistent 𝒮sb 𝒪sb sb".
	then
	have "sharing_consistent 𝒮sb 𝒪sb (sb @ [Writesb False a (D,f) (f θsb) A L R W])"
	  by (simp add:  sharing_consistent_append)
	from sharing_consis_nth_update [OF i_bound this]
	show "sharing_consis 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒪sb' sb' 𝒮sb')
      next
	from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound tssb_i] ]
	show "read_only_unowned 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' 𝒪sb')
      next
	from unowned_shared_nth_update [OF i_bound tssb_i subset_refl]
	show "unowned_shared 𝒮sb' tssb'"
	  by (simp add: tssb' "issb" sb' 𝒪sb' θsb' 𝒮sb')
      next
	from a_unshared
	have "a  read_only (share sb 𝒮sb)"
	  by (auto simp add: read_only_def dom_def)
	with no_outstanding_write_to_read_only_memory [OF i_bound tssb_i] 

	have "no_write_to_read_only_memory 𝒮sb (sb @ [Writesb False a (D,f) (f θsb) A L R W])"
	  by (simp add: no_write_to_read_only_memory_append)
	
	from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
	show "no_outstanding_write_to_read_only_memory 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' sb')
      qed

      have tmps_distinct': "tmps_distinct tssb'"
      proof (intro_locales)
	from load_tmps_distinct [OF i_bound tssb_i]
	have "distinct_load_tmps issb'" 
	  by (auto split: instr.splits simp add: "issb")
	from load_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_distinct tssb'"	  
	  by (simp add: tssb' "issb" sb' 𝒪sb' θsb')      
      next
	from read_tmps_distinct [OF i_bound tssb_i]
	have "distinct_read_tmps sb".
	hence "distinct_read_tmps (sb @ [Writesb False a (D,f) (f θsb) A L R W])" 
	  by (simp add: distinct_read_tmps_append)
	from read_tmps_distinct_nth_update [OF i_bound this]
	show "read_tmps_distinct tssb'"
	  by (simp add: tssb' "issb" sb' 𝒪sb' θsb')      
      next
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i] 
          load_tmps_distinct [OF i_bound tssb_i]
	have "load_tmps issb'  read_tmps (sb @ [Writesb False a (D,f) (f θsb) A L R W]) = {}"
	  by (clarsimp simp add: read_tmps_append "issb")
	from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_read_tmps_distinct tssb'" 
	  by (simp add: tssb' "issb" sb' 𝒪sb' θsb')      
      qed

      have valid_sops': "valid_sops tssb'"
      proof -
	from valid_store_sops [OF i_bound tssb_i]
	obtain valid_Df: "valid_sop (D,f)" and  
	  valid_store_sops': "sopstore_sops issb'. valid_sop sop"
	  by (auto simp add: "issb")
	from valid_Df valid_write_sops [OF i_bound tssb_i]
	have valid_write_sops': "sopwrite_sops (sb@ [Writesb False a (D, f) (f θsb) A L R W]). 
	  valid_sop sop"
	  by (auto simp add: write_sops_append)
	from valid_sops_nth_update [OF i_bound  valid_write_sops' valid_store_sops']
	show ?thesis 	  
	  by (simp add: tssb' "issb" sb' 𝒪sb' θsb')      
      qed

      have valid_dd': "valid_data_dependency tssb'"
      proof -
	from data_dependency_consistent_instrs [OF i_bound tssb_i]
	obtain D_indep: "D  load_tmps issb' = {}" and 
	  dd_is: "data_dependency_consistent_instrs (dom θsb') issb'"
	  by (auto simp add: "issb" θsb')
	from load_tmps_write_tmps_distinct [OF i_bound tssb_i] D_indep
	have "load_tmps issb'  
	      (fst ` write_sops (sb@ [Writesb False a (D, f) (f θsb) A L R W])) = {}"
	  by (auto simp add: write_sops_append "issb")
	from valid_data_dependency_nth_update [OF i_bound dd_is this]
	show ?thesis 	  
	  by (simp add: tssb' "issb" sb' 𝒪sb' θsb')      
      qed

      have load_tmps_fresh': "load_tmps_fresh tssb'"
      proof -
	from load_tmps_fresh [OF i_bound tssb_i] 
	have "load_tmps issb'  dom θsb = {}"
	  by (auto simp add: "issb")
	from load_tmps_fresh_nth_update [OF i_bound this]
	show ?thesis 	  
	  by (simp add: tssb' "issb" sb' 𝒪sb' θsb')      
      qed

      have enough_flushs': "enough_flushs tssb'"
      proof -
	from clean_no_outstanding_volatile_Writesb [OF i_bound tssb_i]
	have "¬ 𝒟sb  outstanding_refs is_volatile_Writesb (sb@[Writesb False a (D,f) (f θsb) A L R W]) = {}"
	  by (auto simp add: outstanding_refs_append )
	from enough_flushs_nth_update [OF i_bound this]
	show ?thesis
	  by (simp add: tssb' sb' 𝒟sb')
      qed


      have valid_program_history': "valid_program_history tssb'"
      proof -	
	from valid_program_history [OF i_bound tssb_i]
	have "causal_program_history issb sb" .
	then have causal': "causal_program_history issb' (sb@[Writesb False a (D,f) (f θsb) A L R W])"
	  by (auto simp: causal_program_history_Write  "issb")
	from valid_last_prog [OF i_bound tssb_i]
	have "last_prog psb sb = psb".
	hence "last_prog psb (sb @ [Writesb False a (D,f) (f θsb) A L R W]) = psb"
	  by (simp add: last_prog_append_Writesb)
	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb' sb')
      qed
      

      from valid_store_sops [OF i_bound tssb_i, rule_format]
      have "valid_sop (D,f)" by (auto simp add: "issb")
      then interpret valid_sop "(D,f)" .

      show ?thesis
      proof (cases "outstanding_refs is_volatile_Writesb sb = {}")
	case True
      
	from True have flush_all: "takeWhile (Not  is_volatile_Writesb) sb = sb"
	  by (auto simp add: outstanding_refs_conv)
      
	from True have suspend_nothing: "dropWhile (Not  is_volatile_Writesb) sb = []"
	  by (auto simp add: outstanding_refs_conv)

	hence suspends_empty: "suspends = []"
	  by (simp add: suspends)

	from suspends_empty is_sim have "is": "is = Write False a (D,f) A L R W# issb'"
	  by (simp add: "issb")
	with suspends_empty ts_i 
	have ts_i: "ts!i = (psb, Write False a (D,f) A L R W# issb',
                     θsb,(),
                     𝒟, acquired True ?take_sb 𝒪sb,release ?take_sb (dom (𝒮sb)) sb)"
	  by simp

	from direct_memop_step.WriteNonVolatile [OF ]
	have "(Write False a (D, f) A L R W# issb', 
	  θsb, (),m,𝒟,acquired True ?take_sb 𝒪sb ,release ?take_sb (dom (𝒮sb)) sb, 𝒮)  
               (issb',
                  θsb, (), m(a := f θsb), 𝒟, acquired True ?take_sb 𝒪sb,
                  release ?take_sb (dom (𝒮sb)) sb, 𝒮)".
	from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
	have "(ts, m, 𝒮) d 
              (ts[i := (psb, issb', θsb, (),𝒟, acquired True ?take_sb 𝒪sb,
                  release ?take_sb (dom (𝒮sb)) sb)], 
	       m(a := f θsb),𝒮)".

	moreover


	have "j<length tssb. i  j 
          (let (_,_, _, sbj,_,_,_) = tssb ! j
          in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))"
	proof -
	  {
	    fix j pj "isj" 𝒪j j 𝒟j acqj xsj sbj
	    assume j_bound: "j < length tssb"
	    assume neq_i_j: "i  j"
	    assume jth: "tssb!j = (pj,isj, xsj, sbj, 𝒟j, 𝒪j,j)"
	    have "a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	    proof 
	      assume a_in: "a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	      hence "a  outstanding_refs is_non_volatile_Writesb sbj"
		using outstanding_refs_append [of is_non_volatile_Writesb "(takeWhile (Not  is_volatile_Writesb) sbj)"
		"(dropWhile (Not  is_volatile_Writesb) sbj)"]
		by auto
	      with non_volatile_owned_or_read_only_outstanding_non_volatile_writes 
	      [OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]]
	      have j_owns: "a  𝒪j  all_acquired sbj"
		by auto

	      from j_owns a_owned'' ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth]
	      show False
		by auto
	    qed
	  }
	  thus ?thesis by (fastforce simp add: Let_def)
	qed

	note flush_commute = flush_all_until_volatile_write_append_non_volatile_write_commute
        [OF True i_bound tssb_i this]

	from suspend_nothing
	have suspend_nothing': "(dropWhile (Not  is_volatile_Writesb) sb') = []"
	  by (simp add: sb')

	from 𝒟
	have 𝒟': "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb 
	  (sb@[Writesb False a (D,f) (f θsb) A L R W])   {})"
	  by (auto simp: outstanding_refs_append)

	have "(tssb',msb,𝒮sb')  
	   (ts[i := (psb,issb', θsb,(),𝒟, acquired True ?take_sb 𝒪sb,
                     release ?take_sb (dom (𝒮sb)) sb)], 
                m(a:=f θsb),𝒮)"
	  apply (rule sim_config.intros) 
	  apply    (simp add: m flush_commute tssb' 𝒪sb' ℛsb' sb' θsb' 𝒟sb' )
	  using  share_all_until_volatile_write_Write_commute 
	          [OF i_bound tssb_i [simplified issb]]
	  apply   (clarsimp simp add: 𝒮 𝒮sb' tssb' sb' 𝒪sb' ℛsb' θsb')
	  using  leq
	  apply  (simp add: tssb')
	  using i_bound i_bound' ts_sim ts_i True 𝒟'
	  apply (clarsimp simp add: Let_def nth_list_update 
	    outstanding_refs_conv tssb' 𝒪sb' ℛsb' 𝒮sb' θsb' sb' 𝒟sb' suspend_nothing' flush_all 
	    acquired_append release_append split: if_split_asm)
	  done	

	ultimately 
	show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_sops'
	    valid_dd' load_tmps_fresh' enough_flushs' 
	    valid_program_history' valid' msb' 𝒮sb' 
	  by (auto simp del: fun_upd_apply)
      next

	case False

	then obtain r where r_in: "r  set sb" and volatile_r: "is_volatile_Writesb r"
	  by (auto simp add: outstanding_refs_conv)
	from takeWhile_dropWhile_real_prefix 
	[OF r_in, of  "(Not  is_volatile_Writesb)", simplified, OF volatile_r] 
	obtain a' v' sb'' sop' A' L' R' W' where
	  sb_split: "sb = takeWhile (Not  is_volatile_Writesb) sb @ Writesb True a' sop' v' A' L' R' W'# sb''" 
	  and
	  drop: "dropWhile (Not  is_volatile_Writesb) sb = Writesb True a' sop' v' A' L' R' W'# sb''"
	  apply (auto)
    subgoal for y ys
	  apply (case_tac y)
	  apply auto
	  done
	  done 
	from drop suspends have suspends: "suspends = Writesb True a' sop' v' A' L' R' W'# sb''"
	  by simp

	have "(ts, m, 𝒮) d* (ts, m, 𝒮)" by auto

	moreover

	note flush_commute =
	  flush_all_until_volatile_write_append_unflushed [OF False i_bound tssb_i]

	have "Writesb True a' sop' v' A' L' R' W'  set sb"
	  by (subst sb_split) auto
	note drop_app = dropWhile_append1 [OF this, of "(Not  is_volatile_Writesb)", simplified]

	from 𝒟
	have 𝒟': "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb (sb@[Writesb False a (D,f) (f θsb) A L R W])   {})"
	  by (auto simp: outstanding_refs_append)


	have "(tssb',msb,𝒮sb')  (ts,m,𝒮)"
	  apply (rule sim_config.intros) 
	  apply    (simp add: m flush_commute tssb' 𝒪sb' ℛsb' θsb' sb')
	  using   share_all_until_volatile_write_Write_commute 
	           [OF i_bound tssb_i [simplified issb]]
	  apply   (clarsimp simp add: 𝒮 𝒮sb' tssb' sb' 𝒪sb' ℛsb' θsb')
	  using  leq
	  apply  (simp add: tssb')
	  using i_bound i_bound' ts_sim ts_i is_sim 𝒟'
	  apply (clarsimp simp add: Let_def nth_list_update is_sim drop_app
	    read_tmps_append suspends 
	    prog_instrs_append_Writesb instrs_append_Writesb hd_prog_append_Writesb
	    drop "issb" tssb' sb' 𝒪sb' ℛsb' 𝒮sb' 
            θsb' 𝒟sb' acquired_append takeWhile_append1 [OF r_in]
	    volatile_r
	    split: if_split_asm)
	  done
	ultimately show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_dd'
	    valid_sops' load_tmps_fresh' enough_flushs' 
	    valid_program_history' valid' msb' 𝒮sb' 
	  by (auto simp del: fun_upd_apply )
      qed
    next	
      case (SBHWriteVolatile a D f A L R W)
      then obtain 
	"issb": "issb = Write True a (D, f) A L R W# issb'" and
	𝒪sb': "𝒪sb'=𝒪sb" andsb': "sb'=sb" and
	θsb': "θsb' = θsb" and
	𝒟sb': "𝒟sb'=True" and
	sb': "sb'=sb@[Writesb True a (D, f) (f θsb) A L R W]" and
	msb': "msb' = msb" and
	𝒮sb': "𝒮sb'=𝒮sb" 
	by auto

      from data_dependency_consistent_instrs [OF i_bound tssb_i]
      have D_subset: "D  dom θsb" 
	by (simp add: issb)

      from safe_memop_flush_sb [simplified issb] obtain      
	a_unowned_others_ts:
          "j<length (map owned ts). i  j  (a  owned (ts!j)  dom (released (ts!j)))" and
        L_subset: "L  A" and
	A_shared_owned: "A  dom (share ?drop_sb 𝒮)  acquired True sb 𝒪sb" and
	R_acq: "R  acquired True sb 𝒪sb" and
	A_R: "A  R = {}" and
        A_unowned_by_others_ts:  
	"j<length (map owned ts). ij  (A  (owned (ts!j)  dom (released (ts!j))) = {})" and
	a_not_ro': "a  read_only (share ?drop_sb 𝒮)"
	by cases auto


      from a_unowned_others_ts ts_sim leq
      have a_unowned_others:
        "j<length tssb. i  j  
          (let (_,_,_,sbj,_,𝒪j,_) = tssb!j in 
	    a  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j 
            a  all_shared (takeWhile (Not  is_volatile_Writesb) sbj))" 
  apply (clarsimp simp add: Let_def)
  subgoal for j
	apply (drule_tac x=j in spec)
	apply (auto simp add: dom_release_takeWhile)
	done
  done
(*
      from a_unowned_others_ts ts_sim leq
      have a_unowned_others:
        "∀j<length (map owns_sb tssb). i ≠ j ⟶ 
          (let (𝒪j,sbj) = (map owns_sb tssb)!j in 
	    a ∉ acquired True (takeWhile (Not ∘ is_volatile_Writesb) sbj) 𝒪j ∧
            a ∉ all_shared (takeWhile (Not ∘ is_volatile_Writesb) sbj))" 
	apply (clarsimp simp add: Let_def)
	apply (drule_tac x=j in spec)
	apply (auto simp add: dom_release_takeWhile)
	done
*)
(*
      from a_unowned_others
      have a_unacquired_others:
        "∀j<length tssb. i ≠ j ⟶ 
          (let (_,_,_,sbj,_,_) = tssb!j in 
	    a ∉ all_acquired (takeWhile (Not ∘ is_volatile_Writesb) sbj))" 
	by (auto simp add: acquired_takeWhile_non_volatile_Writesb)
*)
      have a_not_ro: "a  read_only (share sb 𝒮sb)"
      proof 
	assume a: "a  read_only (share sb 𝒮sb)"
	from local.read_only_unowned_axioms have "read_only_unowned 𝒮sb tssb".
        from in_read_only_share_all_until_volatile_write' [OF ownership_distinct_tssb sharing_consis_tssb
          ‹read_only_unowned 𝒮sb tssb i_bound tssb_i a_unowned_others a] 
	have "a  read_only (share ?drop_sb 𝒮)"
	  by (simp add: 𝒮)
	with a_not_ro' show False by simp
      qed
      
      from A_unowned_by_others_ts ts_sim leq
      have A_unowned_by_others:  
	"j<length tssb. ij  (let (_,_,_,sbj,_,𝒪j,_) = tssb!j 
	  in A  (acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j 
                  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)) = {})" 
  apply (clarsimp simp add: Let_def)
  subgoal for j
	apply (drule_tac x=j in spec)
	apply (force simp add: dom_release_takeWhile)
	done
  done
      have a_not_acquired_others: "j<length (map 𝒪_sb tssb). i  j  
        (let (𝒪j,sbj) = (map 𝒪_sb tssb)!j in a  all_acquired sbj)" 
      proof -
	{
	  fix j 𝒪j sbj
	  assume j_bound: "j < length (map owned tssb)"
	  assume neq_i_j: "ij"
	  assume tssb_j: "(map 𝒪_sb tssb)!j = (𝒪j,sbj)"
	  assume conflict: "a  all_acquired sbj"
	  have False
	  proof -
	    from j_bound leq
	    have j_bound': "j < length (map owned ts)"
	      by auto
	    from j_bound have j_bound'': "j < length tssb"
	      by auto
	    from j_bound' have j_bound''': "j < length ts"
	      by simp

	    let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	    let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"

	    from ts_sim [rule_format, OF  j_bound''] tssb_j j_bound''
            
	    obtain pj suspendsj "issbj" j 𝒟sbj 𝒟j θsbj "isj" where
		  tssb_j: "tssb ! j = (pj,issbj, θsbj, sbj, 𝒟sbj,𝒪j,j)"  and
		  suspendsj: "suspendsj = dropWhile (Not  is_volatile_Writesb) sbj" and
		  isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	          𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
		  tsj: "ts!j = (hd_prog pj suspendsj, isj,
                               θsbj |` (dom θsbj - read_tmps suspendsj),(), 
	                       𝒟j, 
                               acquired True ?take_sbj 𝒪j,
                               release ?take_sbj (dom 𝒮sb) j)"
	      apply (cases "tssb!j")
	      apply (force simp add: Let_def)
	      done

            
	    from a_unowned_others [rule_format,OF _ neq_i_j] tssb_j j_bound
	    obtain a_unacq: "a  acquired True ?take_sbj 𝒪j" and a_not_shared: "a  all_shared ?take_sbj"
	      by auto
            have conflict_drop: "a  all_acquired suspendsj"
            proof (rule ccontr)
              assume "a  all_acquired suspendsj"
              with all_acquired_append [of ?take_sbj ?drop_sbj] conflict
              have "a  all_acquired ?take_sbj"
                by (auto simp add: suspendsj)
              from all_acquired_unshared_acquired [OF this a_not_shared] a_unacq
              show False by auto
            qed


	    from j_bound''' i_bound' have j_bound_ts': "j < length ?ts'"
	      by simp

	    (* FIXME: extract common intermediate steps of both cases*)
	    from split_all_acquired_in [OF conflict_drop]
	    show ?thesis
	    proof
	      assume "sop a' v ys zs A L R W. 
                suspendsj = ys @ Writesb True a' sop v A L R W# zs  a  A"
	      then 
	      obtain a' sop' v' ys zs A' L' R' W' where
		split_suspendsj: "suspendsj = ys @ Writesb True a' sop' v' A' L' R' W'# zs" 
		(is "suspendsj = ?suspends") and
		a_A': "a  A'"
		by blast

	      from sharing_consis [OF j_bound'' tssb_j]
	      have sharing_consis_j: "sharing_consistent 𝒮sb 𝒪j sbj".
	      then have A'_R': "A'  R' = {}" 
		by (simp add: sharing_consistent_append [of _ _ ?take_sbj ?drop_sbj, simplified] 
		  suspendsj [symmetric] split_suspendsj sharing_consistent_append)
	      from valid_program_history [OF j_bound'' tssb_j] 
	      have "causal_program_history issbj sbj".
	      then have cph: "causal_program_history issbj ?suspends"
		apply -
		apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply (simp add: split_suspendsj)
		done

	      from tsj neq_i_j j_bound 
	      have ts'_j: "?ts'!j = (hd_prog pj suspendsj, isj,
		θsbj |` (dom θsbj - read_tmps suspendsj),(), 
		𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
		by auto
	      from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
	      then
	      have lp: "last_prog pj suspendsj = pj"
		apply -
		apply (rule last_prog_same_append [where sb="?take_sbj"])
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done


	      from valid_reads [OF j_bound'' tssb_j]
	      have reads_consis_j: "reads_consistent False 𝒪j msb sbj".

	      from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb 
		j_bound'' tssb_j this]
	      have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		by (simp add: m suspendsj)

	      from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j tssb_i tssb_j]
	      have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
		by (simp add: suspendsj)
	      from reads_consistent_flush_independent [OF this reads_consis_m_j]
	      have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
		(flush ?drop_sb m) suspendsj".

	      hence reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  
		(flush ?drop_sb m) (ys@[Writesb True a' sop' v' A' L' R' W'])"
		by (simp add: split_suspendsj reads_consistent_append)

	      from valid_write_sops [OF j_bound'' tssb_j]
	      have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		valid_sops_drop: "sopwrite_sops (ys@[Writesb True a' sop' v' A' L' R' W']). valid_sop sop"
		apply (simp only: write_sops_append)
		apply auto
		done

	      from read_tmps_distinct [OF j_bound'' tssb_j]
	      have "distinct_read_tmps (?take_sbj@suspendsj)"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain 
		read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
		distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		apply (simp only: distinct_read_tmps_append)
		done

	      from valid_history [OF j_bound'' tssb_j]
	      have h_consis: 
		"history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done
	    
	      have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	      proof -
		from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		  by simp
		from last_prog_hd_prog_append' [OF h_consis] this
		have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		  by (simp only: split_suspendsj [symmetric] suspendsj) 
		moreover 
		have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		  last_prog (hd_prog pj suspendsj) ?take_sbj"
		  apply (simp only: split_suspendsj [symmetric] suspendsj) 
		  by (rule last_prog_hd_prog_append)
		ultimately show ?thesis
		  by (simp add: split_suspendsj [symmetric] suspendsj) 
	      qed

	      from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
		h_consis] last_prog_hd_prog
	      have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      from reads_consistent_drop_volatile_writes_no_volatile_reads  
	      [OF reads_consis_j] 
	      have no_vol_read: "outstanding_refs is_volatile_Readsb 
		(ys@[Writesb True a' sop' v' A' L' R' W']) = {}"
		by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		  split_suspendsj )

	      have acq_simp:
		"acquired True (ys @ [Writesb True a' sop' v' A' L' R' W']) 
                    (acquired True ?take_sbj 𝒪j) = 
                 acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R'"
		by (simp add: acquired_append)

	      from flush_store_buffer_append [where sb="ys@[Writesb True a' sop' v' A' L' R' W']" and sb'="zs", simplified,
	      OF j_bound_ts' isj [simplified split_suspendsj] cph [simplified suspendsj]
	      ts'_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys 
	      hist_consis' [simplified split_suspendsj] valid_sops_drop 
	      distinct_read_tmps_drop [simplified split_suspendsj] 
		no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="share ?drop_sb 𝒮"]
	      obtain isj' j' where
		isj': "instrs zs @ issbj = isj' @ prog_instrs zs" and
		steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮)  d* 
		  (?ts'[j:=(last_prog
                              (hd_prog pj (Writesb True a' sop' v' A' L' R' W'# zs)) (ys@[Writesb True a' sop' v' A' L' R' W']),
                             isj',
                             θsbj |` (dom θsbj - read_tmps zs),
                              (), True, acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R',j')],
                    flush (ys@[Writesb True a' sop' v' A' L' R' W']) (flush ?drop_sb m),
                    share (ys@[Writesb True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
		   (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
                by (auto simp add: acquired_append outstanding_refs_append)

	      from i_bound' have i_bound_ys: "i < length ?ts_ys"
		by auto

	      from i_bound' neq_i_j 
	      have ts_ys_i: "?ts_ys!i = (psb, issb, θsb,(), 
		𝒟sb, acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb)"
		by simp
	      note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
	      
	      from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	      have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	      
	      from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified issb] 
	      have a_unowned: 
		"j < length ?ts_ys. ij  (let (𝒪j) = map owned ?ts_ys!j in a  𝒪j)"
		apply cases
		apply (auto simp add: Let_def issb)
		done
	      from a_A' a_unowned [rule_format, of j] neq_i_j j_bound' A'_R'
	      show False
		by (auto simp add: Let_def)
	    next
	      assume "A L R W ys zs. suspendsj = ys @ Ghostsb A L R W# zs  a  A"
	      then 
	      obtain A' L' R' W' ys zs where
		split_suspendsj: "suspendsj = ys @ Ghostsb A' L' R' W'# zs" 
		(is "suspendsj = ?suspends") and
		  a_A': "a  A'"
		by blast

	      from sharing_consis [OF j_bound'' tssb_j]
	      have sharing_consis_j: "sharing_consistent 𝒮sb 𝒪j sbj".
	      then have A'_R': "A'  R' = {}" 
		by (simp add: sharing_consistent_append [of _ _ ?take_sbj ?drop_sbj, simplified] 
		  suspendsj [symmetric] split_suspendsj sharing_consistent_append)
	      from valid_program_history [OF j_bound'' tssb_j] 
	      have "causal_program_history issbj sbj".
	      then have cph: "causal_program_history issbj ?suspends"
		apply -
		apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply (simp add: split_suspendsj)
		done

	      from tsj neq_i_j j_bound 
	      have ts'_j: "?ts'!j = (hd_prog pj suspendsj, isj,
		θsbj |` (dom θsbj - read_tmps suspendsj),(), 
		𝒟j, acquired True ?take_sbj 𝒪j, release ?take_sbj (dom 𝒮sb) j)"
		by auto
	      from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
	      then
	      have lp: "last_prog pj suspendsj = pj"
		apply -
		apply (rule last_prog_same_append [where sb="?take_sbj"])
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done


	      from valid_reads [OF j_bound'' tssb_j]
	      have reads_consis_j: "reads_consistent False 𝒪j msb sbj".
	      from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb 
		j_bound'' tssb_j this]
	      have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		by (simp add: m suspendsj)

	      from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j tssb_i tssb_j]
	      have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
		by (simp add: suspendsj)
	      from reads_consistent_flush_independent [OF this reads_consis_m_j]
	      have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
		(flush ?drop_sb m) suspendsj".

	      hence reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  
		(flush ?drop_sb m) (ys@[Ghostsb A' L' R' W'])"
		by (simp add: split_suspendsj reads_consistent_append)

	      from valid_write_sops [OF j_bound'' tssb_j]
	      have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		valid_sops_drop: "sopwrite_sops (ys@[Ghostsb A' L' R' W']). valid_sop sop"
		apply (simp only: write_sops_append)
		apply auto
		done

	      from read_tmps_distinct [OF j_bound'' tssb_j]
	      have "distinct_read_tmps (?take_sbj@suspendsj)"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain 
		read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
		distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		apply (simp only: distinct_read_tmps_append)
		done

	      from valid_history [OF j_bound'' tssb_j]
	      have h_consis: 
		"history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done
	    
	      have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	      proof -
		from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		  by simp
		from last_prog_hd_prog_append' [OF h_consis] this
		have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		  by (simp only: split_suspendsj [symmetric] suspendsj) 
		moreover 
		have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		  last_prog (hd_prog pj suspendsj) ?take_sbj"
		  apply (simp only: split_suspendsj [symmetric] suspendsj) 
		  by (rule last_prog_hd_prog_append)
		ultimately show ?thesis
		  by (simp add: split_suspendsj [symmetric] suspendsj) 
	      qed

	      from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
		h_consis] last_prog_hd_prog
	      have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      from reads_consistent_drop_volatile_writes_no_volatile_reads  
	      [OF reads_consis_j] 
	      have no_vol_read: "outstanding_refs is_volatile_Readsb 
		(ys@[Ghostsb A' L' R' W']) = {}"
		by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		  split_suspendsj )

	      have acq_simp:
		"acquired True (ys @ [Ghostsb A' L' R' W']) 
                    (acquired True ?take_sbj 𝒪j) = 
                 acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R'"
		by (simp add: acquired_append)

	      from flush_store_buffer_append [where sb="ys@[Ghostsb A' L' R' W']" and sb'="zs", simplified,
	      OF j_bound_ts' isj [simplified split_suspendsj] cph [simplified suspendsj]
	      ts'_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys 
	      hist_consis' [simplified split_suspendsj] valid_sops_drop 
	      distinct_read_tmps_drop [simplified split_suspendsj] 
	      no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="share ?drop_sb 𝒮"]
	      obtain isj' j'  where
		isj': "instrs zs @ issbj = isj' @ prog_instrs zs" and
		steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮)  d* 
		  (?ts'[j:=(last_prog
                              (hd_prog pj (Ghostsb A' L' R' W'# zs)) (ys@[Ghostsb A' L' R' W']),
                             isj',
                             θsbj |` (dom θsbj - read_tmps zs),
                              (),
                             𝒟j  outstanding_refs is_volatile_Writesb (ys @ [Ghostsb A' L' R' W'])  {}, acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R',j')],
                    flush (ys@[Ghostsb A' L' R' W']) (flush ?drop_sb m),
                    share (ys@[Ghostsb A' L' R' W']) (share ?drop_sb 𝒮))"
		   (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
                by (auto simp add: acquired_append)

	      from i_bound' have i_bound_ys: "i < length ?ts_ys"
		by auto

	      from i_bound' neq_i_j 
	      have ts_ys_i: "?ts_ys!i = (psb, issb,θsb,(), 
		𝒟sb, acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb)"
		by simp
	      note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
	      
	      from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	      have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	      
	      from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified issb] 
	      have a_unowned: 
		"j < length ?ts_ys. ij  (let (𝒪j) = map owned ?ts_ys!j in a  𝒪j)"
		apply cases
		apply (auto simp add: Let_def issb)
		done
	      from a_A' a_unowned [rule_format, of j] neq_i_j j_bound' A'_R'
	      show False
		by (auto simp add: Let_def)
	    qed
	  qed
	}
	thus ?thesis
	  by (auto simp add: Let_def)
      qed

       
      have A_unused_by_others:
	  "j<length (map 𝒪_sb tssb). i  j 
             (let (𝒪j, sbj) = map 𝒪_sb tssb! j
             in A  outstanding_refs is_volatile_Writesb sbj = {})"
      proof -
	{
	  fix j 𝒪j sbj
	  assume j_bound: "j < length (map owned tssb)"
	  assume neq_i_j: "ij"
	  assume tssb_j: "(map 𝒪_sb tssb)!j = (𝒪j,sbj)"
	  assume conflict: "A  outstanding_refs is_volatile_Writesb sbj  {}"
	  have False
	  proof -
	    from j_bound leq
	    have j_bound': "j < length (map owned ts)"
	      by auto
	    from j_bound have j_bound'': "j < length tssb"
	      by auto
	    from j_bound' have j_bound''': "j < length ts"
	      by simp
	    
	    from conflict obtain a' where
	      a'_in: "a'  A" and
              a'_in_j: "a'  outstanding_refs is_volatile_Writesb sbj"
	      by auto

	    let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	    let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"

	    from ts_sim [rule_format, OF  j_bound''] tssb_j j_bound''
	    obtain pj suspendsj "issbj" 𝒟sbj 𝒟j j θsbj "isj" where
	      tssb_j: "tssb ! j = (pj,issbj, θsbj, sbj,𝒟sbj,𝒪j,j)" and
	      suspendsj: "suspendsj = ?drop_sbj" and
	      isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	      𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
	      tsj: "ts!j = (hd_prog pj suspendsj, isj,
	             θsbj |` (dom θsbj - read_tmps suspendsj),(), 𝒟j, 
                     acquired True ?take_sbj 𝒪j,
                     release ?take_sbj (dom 𝒮sb) j)"
	      apply (cases "tssb!j")
	      apply (force simp add: Let_def)
	      done
	      
	    have "a'  outstanding_refs is_volatile_Writesb suspendsj"
	    proof -	
	      from a'_in_j 
	      have "a'  outstanding_refs is_volatile_Writesb (?take_sbj @ ?drop_sbj)"
		by simp
	      thus ?thesis
		apply (simp only: outstanding_refs_append suspendsj)
		apply (auto simp add: outstanding_refs_conv dest: set_takeWhileD)
		done
	    qed
		
	    from split_volatile_Writesb_in_outstanding_refs [OF this]
	    obtain sop v ys zs A' L' R' W' where
	      split_suspendsj: "suspendsj = ys @ Writesb True a' sop v A' L' R' W'# zs" (is "suspendsj = ?suspends")
	      by blast
	    
	    from direct_memop_step.WriteVolatile [where  θ=θsb and m="flush ?drop_sb m"]
	    have "(Write True a (D, f) A L R W# issb', 
                       θsb, (), flush ?drop_sb m,𝒟sb,acquired True sb 𝒪sb,
                        release sb (dom 𝒮sb) sb, 
                        share ?drop_sb 𝒮)  
                    (issb', θsb, (), (flush ?drop_sb m)(a := f θsb), True, acquired True sb 𝒪sb  A - R, Map.empty,
                      share ?drop_sb 𝒮W RA L)".

	    from direct_computation.concurrent_step.Memop [OF 
	      i_bound_ts' [simplified issb] ts'_i [simplified issb] this [simplified issb]] 
	    have store_step: "(?ts', flush ?drop_sb m,share ?drop_sb 𝒮 ) d 
                    (?ts'[i := (psb, issb', θsb, (), 
                         True, acquired True sb 𝒪sb  A - R,Map.empty)], 
                         (flush ?drop_sb m)(a := f θsb), share ?drop_sb 𝒮W RA L )"
		  (is " _ d (?ts_A, ?m_A, ?share_A)")
	     by (simp add: issb)
	      
	       
	   from i_bound' have i_bound'': "i < length ?ts_A"
	     by simp

	   from valid_program_history [OF j_bound'' tssb_j] 
	   have "causal_program_history issbj sbj".
	   then have cph: "causal_program_history issbj ?suspends"
	     apply -
	     apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
	     apply (simp only: split_suspendsj [symmetric] suspendsj)
	     apply (simp add: split_suspendsj)
	     done
	   
	   from tsj neq_i_j j_bound 
	   have ts_A_j: "?ts_A!j = (hd_prog pj (ys @ Writesb True a' sop v A' L' R' W'# zs), isj,
	     θsbj |` (dom θsbj - read_tmps (ys @ Writesb True a' sop v A' L' R' W'# zs)), (), 𝒟j, 
	     acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	     by (simp add: split_suspendsj)


	   from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
	     by simp

	   from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
	   then
	   have lp: "last_prog pj ?suspends = pj"
	     apply -
	     apply (rule last_prog_same_append [where sb="?take_sbj"])
	     apply (simp only: split_suspendsj [symmetric] suspendsj)
	     apply simp
	     done

	   from valid_reads [OF j_bound'' tssb_j]
	   have reads_consis: "reads_consistent False 𝒪j msb sbj".

	   from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb j_bound''
	     tssb_j reads_consis]
	   have reads_consis_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
	     by (simp add: m suspendsj)

	   from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j tssb_i tssb_j]
	   have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
	     by (simp add: suspendsj)
	   from reads_consistent_flush_independent [OF this reads_consis_m]
	   have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	     (flush ?drop_sb m) suspendsj".

	   from a_unowned_others [rule_format, OF _ neq_i_j] j_bound tssb_j
	   obtain a_notin_owns_j: "a  acquired True ?take_sbj 𝒪j" and a_unshared: "a  all_shared ?take_sbj"
	     by auto
	   from a_not_acquired_others [rule_format, OF _ neq_i_j] j_bound tssb_j
	   have a_not_acquired_j: "a  all_acquired sbj"
	     by auto
	   
	   from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' tssb_j]
	   have nvo_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j sbj".
	   
	   (* FIXME: make this a lemma, duplicated some times below *)
	   have a_no_non_vol_read: "a  outstanding_refs is_non_volatile_Readsb ?drop_sbj"
	   proof 
	     assume a_in_nvr:"a  outstanding_refs is_non_volatile_Readsb ?drop_sbj"

	     from reads_consistent_drop [OF reads_consis]
	     have rc: "reads_consistent True (acquired True ?take_sbj 𝒪j) (flush ?take_sbj msb) ?drop_sbj".

	     from non_volatile_owned_or_read_only_drop [OF nvo_j]
	     have nvo_j_drop: "non_volatile_owned_or_read_only True (share ?take_sbj 𝒮sb)
	       (acquired True ?take_sbj 𝒪j)
	       ?drop_sbj"
	       by simp

	     from outstanding_refs_non_volatile_Readsb_all_acquired [OF rc this a_in_nvr]

	     have a_owns_acq_ror: 
	       "a  𝒪j  all_acquired sbj  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	       by (auto dest!: acquired_all_acquired_in all_acquired_takeWhile_dropWhile_in
		 simp add: acquired_takeWhile_non_volatile_Writesb)

	     have a_unowned_j: "a  𝒪j  all_acquired sbj"
             proof (cases "a  𝒪j")
               case False with a_not_acquired_j show ?thesis by auto
             next
               case True
               from all_shared_acquired_in [OF True a_unshared] a_notin_owns_j
               have False by auto thus ?thesis ..
             qed
	     with a_owns_acq_ror 
	     have a_ror: "a  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	       by auto

	     with read_only_reads_unowned [OF j_bound'' i_bound neq_i_j [symmetric] tssb_j tssb_i]
	     have a_unowned_sb: "a  𝒪sb  all_acquired sb"
	       by auto
	       
	     from sharing_consis [OF j_bound'' tssb_j] sharing_consistent_append [of 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
	     have consis_j_drop: "sharing_consistent (share ?take_sbj 𝒮sb) (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	       by auto
             
	     from read_only_reads_read_only [OF nvo_j_drop consis_j_drop] a_ror a_unowned_j
	       all_acquired_append [of ?take_sbj ?drop_sbj] acquired_takeWhile_non_volatile_Writesb [of sbj 𝒪j]
	     have "a  read_only (share ?take_sbj 𝒮sb)"
	       by (auto simp add: )
             from read_only_share_all_shared [OF this] a_unshared
	     have "a  read_only 𝒮sb"
	       by fastforce
	      
	     from read_only_unacquired_share [OF read_only_unowned [OF i_bound tssb_i] 
	       weak_sharing_consis [OF i_bound tssb_i] this] a_unowned_sb
	     have "a  read_only (share sb 𝒮sb)"
	       by auto
	   
	     with a_not_ro show False
	       by simp
	   qed
	 
	   with reads_consistent_mem_eq_on_non_volatile_reads  [OF _ subset_refl reads_consis_flush_m]
	   have "reads_consistent True (acquired True ?take_sbj 𝒪j) ?m_A suspendsj"
	     by (auto simp add: suspendsj)


	   hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j) ?m_A ys"
	     by (simp add: split_suspendsj reads_consistent_append)

	   from valid_history [OF j_bound'' tssb_j]
	   have h_consis: 
	     "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
	     apply (simp only: split_suspendsj [symmetric] suspendsj)
	     apply simp
	     done

	   have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	   proof -
	     from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
	       by simp
	     from last_prog_hd_prog_append' [OF h_consis] this
	     have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
	       by (simp only: split_suspendsj [symmetric] suspendsj) 
	     moreover 
	     have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		  last_prog (hd_prog pj suspendsj) ?take_sbj"
	       apply (simp only: split_suspendsj [symmetric] suspendsj) 
	       by (rule last_prog_hd_prog_append)
	     ultimately show ?thesis
	       by (simp add: split_suspendsj [symmetric] suspendsj) 
	   qed

	   from valid_write_sops [OF j_bound'' tssb_j]
	   have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
	     by (simp add: split_suspendsj [symmetric] suspendsj)
	   then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
	     valid_sops_drop: "sopwrite_sops ys. valid_sop sop"
	     apply (simp only: write_sops_append )
	     apply auto
	     done

	   from read_tmps_distinct [OF j_bound'' tssb_j]
	   have "distinct_read_tmps (?take_sbj@suspendsj)"
	     by (simp add: split_suspendsj [symmetric] suspendsj)
	   then obtain 
	     read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
	     distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
	     apply (simp only: split_suspendsj [symmetric] suspendsj) 
	     apply (simp only: distinct_read_tmps_append)
	     done
	   
	   from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]	  
	     last_prog_hd_prog
	   have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
	     by (simp add: split_suspendsj [symmetric] suspendsj) 
	    from reads_consistent_drop_volatile_writes_no_volatile_reads  
	    [OF reads_consis] 
	    have no_vol_read: "outstanding_refs is_volatile_Readsb ys = {}"
	      by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )
	   
	    from flush_store_buffer_append [
	      OF j_bound''''  isj [simplified split_suspendsj] cph [simplified suspendsj]
	      ts_A_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_m_A_ys
	      hist_consis' [simplified split_suspendsj] valid_sops_drop distinct_read_tmps_drop [simplified split_suspendsj] 
	      no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="?share_A"]
	    obtain isj' j' where
	      isj': "instrs (Writesb True a' sop v A' L' R' W'# zs) @ issbj = 
	            isj' @ prog_instrs (Writesb True a' sop v A' L' R' W'# zs)" and
	      steps_ys: "(?ts_A, ?m_A, ?share_A)  d* 
		(?ts_A[j:= (last_prog (hd_prog pj (Writesb True a' sop v A' L' R' W'# zs)) ys,
                           isj',
                           θsbj |` (dom θsbj - read_tmps (Writesb True a' sop v A' L' R' W' # zs)),(),
                           𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j') ],
                  flush ys ?m_A,
                  share ys ?share_A)"
		 (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
              by (auto)

	    note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
	    from cph
	    have "causal_program_history issbj ((ys @ [Writesb True a' sop v A' L' R' W']) @ zs)"
	      by simp
	    from causal_program_history_suffix [OF this]
	    have cph': "causal_program_history issbj zs".	      
	    interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

	    from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
	    obtain isj''
	      where isj': "isj' = Write True a' sop A' L' R' W'#isj''" and
	      isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
	      by clarsimp

	    from j_bound'''
	    have j_bound_ys: "j < length ?ts_ys"
	      by auto

	    from j_bound_ys neq_i_j
	    have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog pj (Writesb True a' sop v A' L' R' W'# zs)) ys, isj',
                 θsbj |` (dom θsbj - read_tmps (Writesb True a' sop v A' L' R' W'# zs)),(),
	         𝒟j  outstanding_refs is_volatile_Writesb ys  {},
                 acquired True ys (acquired True ?take_sbj 𝒪j),j')"
	      by auto

	    from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	    have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	    from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified isj']
	    have a_unowned: 
		"i < length ?ts_ys. ji  (let (𝒪i) = map owned ?ts_ys!i in a'  𝒪i)"
	      apply cases
	      apply (auto simp add: Let_def issb)
	      done
	    from a'_in a_unowned [rule_format, of i] neq_i_j i_bound' A_R
	    show False
	      by (auto simp add: Let_def)
	  qed
	}
	thus ?thesis
	  by (auto simp add: Let_def)
      qed
      
      have A_unaquired_by_others:
	  "j<length (map 𝒪_sb tssb). i  j 
             (let (𝒪j, sbj) = map 𝒪_sb tssb! j
             in A  all_acquired sbj = {})"
      proof -
	{
	  fix j 𝒪j sbj
	  assume j_bound: "j < length (map owned tssb)"
	  assume neq_i_j: "ij"
	  assume tssb_j: "(map 𝒪_sb tssb)!j = (𝒪j,sbj)"
	  assume conflict: "A  all_acquired sbj  {}"
	  have False
	  proof -
	    from j_bound leq
	    have j_bound': "j < length (map owned ts)"
	      by auto
	    from j_bound have j_bound'': "j < length tssb"
	      by auto
	    from j_bound' have j_bound''': "j < length ts"
	      by simp
	    
	    from conflict obtain a' where
	      a'_in: "a'  A" and
              a'_in_j: "a'  all_acquired sbj"
	      by auto

	    let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	    let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"

	    from ts_sim [rule_format, OF  j_bound''] tssb_j j_bound''
	    obtain pj suspendsj "issbj" 𝒟sbj 𝒟j j θsbj "isj" where
	      tssb_j: "tssb ! j = (pj,issbj, θsbj, sbj,𝒟sbj,𝒪j,j)" and
	      suspendsj: "suspendsj = ?drop_sbj" and
	      isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	      𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
	      tsj: "ts!j = (hd_prog pj suspendsj, isj, 
	                   θsbj |` (dom θsbj - read_tmps suspendsj),(), 
	                   𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	      apply (cases "tssb!j")
	      apply (force simp add: Let_def)
	      done

	    from a'_in_j all_acquired_append [of ?take_sbj ?drop_sbj]
	    have "a'  all_acquired ?take_sbj  a'  all_acquired suspendsj"
	      by (auto simp add: suspendsj)
	    thus False
	    proof 
	      assume "a'  all_acquired ?take_sbj"
	      with A_unowned_by_others [rule_format, OF _ neq_i_j] tssb_j j_bound a'_in
	      show False
		by (auto dest: all_acquired_unshared_acquired)
	    next
	      assume conflict_drop: "a'  all_acquired suspendsj"
	      from split_all_acquired_in [OF conflict_drop]
	      (* FIXME: exract common parts *)
	      show False
	      proof 
		assume "sop a'' v ys zs A L R W. 
                         suspendsj = ys @ Writesb True a'' sop v A L R W# zs  a'  A" 
	        then
		obtain a'' sop' v' ys zs A' L' R' W' where
		  split_suspendsj: "suspendsj = ys @ Writesb True a'' sop' v' A' L' R' W'# zs" 
		    (is "suspendsj = ?suspends") and
		  a'_A': "a'  A'"
		 by auto
	    
	       from direct_memop_step.WriteVolatile [where  θ=θsb and m="flush ?drop_sb m"]
	       have "(Write True a (D, f) A L R W # issb', 
                         θsb, (), flush ?drop_sb m ,𝒟sb, acquired True sb 𝒪sb,
                         release sb (dom 𝒮sb) sb, 
                         share ?drop_sb 𝒮)  
                    (issb', θsb, (), (flush ?drop_sb m)(a := f θsb), True, acquired True sb 𝒪sb  A - R,Map.empty, 
                      share ?drop_sb 𝒮W RA L)".

	       from direct_computation.concurrent_step.Memop [OF 
		 i_bound_ts' [simplified issb] ts'_i [simplified issb] this [simplified issb]] 

	       have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) d 
                   (?ts'[i := (psb, issb',
		        θsb, (),True, acquired True sb 𝒪sb  A - R,Map.empty)], 
                         (flush ?drop_sb m)(a := f θsb),share ?drop_sb 𝒮W RA L)"
		   (is " _ d (?ts_A, ?m_A, ?share_A)")
		 by (simp add: issb)
	      
	       
	       from i_bound' have i_bound'': "i < length ?ts_A"
		 by simp

	       from valid_program_history [OF j_bound'' tssb_j] 
	       have "causal_program_history issbj sbj".
	       then have cph: "causal_program_history issbj ?suspends"
		 apply -
		 apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply (simp add: split_suspendsj)
		 done
	       
	       from tsj neq_i_j j_bound 
	       have ts_A_j: "?ts_A!j = (hd_prog pj (ys @ Writesb True a'' sop' v' A' L' R' W'# zs), isj, 
		   θsbj |` (dom θsbj - read_tmps (ys @ Writesb True a'' sop' v' A' L' R' W'# zs)), (), 𝒟j, 
		   acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
		 by (simp add: split_suspendsj)


	       from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
		 by simp

	       from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
	       then
	       have lp: "last_prog pj ?suspends = pj"
		 apply -
		 apply (rule last_prog_same_append [where sb="?take_sbj"])
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply simp
		 done
	       
	       from valid_reads [OF j_bound'' tssb_j]
	       have reads_consis: "reads_consistent False 𝒪j msb sbj".
	       
	       from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb 
		 j_bound''
		 tssb_j reads_consis]
	       have reads_consis_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		 by (simp add: m suspendsj)

	       from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j tssb_i tssb_j]
	       have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
		 by (simp add: suspendsj)
	       from reads_consistent_flush_independent [OF this reads_consis_m]
	       have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
		 (flush ?drop_sb m) suspendsj".
       
	       from a_unowned_others [rule_format, OF _ neq_i_j] j_bound tssb_j
	       obtain a_notin_owns_j: "a  acquired True ?take_sbj 𝒪j" and a_unshared: "a  all_shared ?take_sbj"
	         by auto
	       from a_not_acquired_others [rule_format, OF _ neq_i_j] j_bound tssb_j
	       have a_not_acquired_j: "a  all_acquired sbj"
		 by auto
	       
	       from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' tssb_j]
	       have nvo_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j sbj".

	       have a_no_non_vol_read: "a  outstanding_refs is_non_volatile_Readsb ?drop_sbj"
	       proof 
		 assume a_in_nvr:"a  outstanding_refs is_non_volatile_Readsb ?drop_sbj"
		 
		 from reads_consistent_drop [OF reads_consis]
		 have rc: "reads_consistent True (acquired True ?take_sbj 𝒪j) (flush ?take_sbj msb) ?drop_sbj".
		 
		 from non_volatile_owned_or_read_only_drop [OF nvo_j]
		 have nvo_j_drop: "non_volatile_owned_or_read_only True (share ?take_sbj 𝒮sb)
		   (acquired True ?take_sbj 𝒪j)
		   ?drop_sbj"
		   by simp
		 
		 from outstanding_refs_non_volatile_Readsb_all_acquired [OF rc this a_in_nvr]

		 have a_owns_acq_ror: 
		   "a  𝒪j  all_acquired sbj  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
		   by (auto dest!: acquired_all_acquired_in all_acquired_takeWhile_dropWhile_in
		     simp add: acquired_takeWhile_non_volatile_Writesb)
		 have a_unowned_j: "a  𝒪j  all_acquired sbj"
                 proof (cases "a  𝒪j")
                   case False with a_not_acquired_j show ?thesis by auto
                 next
                   case True
                   from all_shared_acquired_in [OF True a_unshared] a_notin_owns_j
                   have False by auto thus ?thesis ..
                 qed

		 
		 with a_owns_acq_ror 
		 have a_ror: "a  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
		   by auto
		 
		 with read_only_reads_unowned [OF j_bound'' i_bound neq_i_j [symmetric] tssb_j tssb_i]
		 have a_unowned_sb: "a  𝒪sb  all_acquired sb"
		   by auto
		 
		 from sharing_consis [OF j_bound'' tssb_j] sharing_consistent_append [of 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
		 have consis_j_drop: "sharing_consistent (share ?take_sbj 𝒮sb) (acquired True ?take_sbj 𝒪j) ?drop_sbj"
		   by auto
		 
		 from read_only_reads_read_only [OF nvo_j_drop consis_j_drop] a_ror a_unowned_j
		   all_acquired_append [of ?take_sbj ?drop_sbj] acquired_takeWhile_non_volatile_Writesb [of sbj 𝒪j]
		 have "a  read_only (share ?take_sbj 𝒮sb)"
		   by (auto)
		 from read_only_share_all_shared [OF this] a_unshared
		 have "a  read_only 𝒮sb"
		   by fastforce
	      
		 from read_only_unacquired_share [OF read_only_unowned [OF i_bound tssb_i] 
		   weak_sharing_consis [OF i_bound tssb_i] this] a_unowned_sb
		 have "a  read_only (share sb 𝒮sb)"
		   by auto
		 
		 with a_not_ro show False
		   by simp
	       qed
	       with reads_consistent_mem_eq_on_non_volatile_reads  [OF _ subset_refl reads_consis_flush_m]
	       have "reads_consistent True (acquired True ?take_sbj 𝒪j) ?m_A suspendsj"
		 by (auto simp add: suspendsj)
	       
	       hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j) ?m_A ys"
		 by (simp add: split_suspendsj reads_consistent_append)

	       
	       from valid_history [OF j_bound'' tssb_j]
	       have h_consis: 
		 "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply simp
		 done
	       
	       have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	       proof -
		 from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		   by simp
		 from last_prog_hd_prog_append' [OF h_consis] this
		 have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		   by (simp only: split_suspendsj [symmetric] suspendsj) 
		 moreover 
		 have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		   last_prog (hd_prog pj suspendsj) ?take_sbj"
		   apply (simp only: split_suspendsj [symmetric] suspendsj) 
		   by (rule last_prog_hd_prog_append)
		 ultimately show ?thesis
		   by (simp add: split_suspendsj [symmetric] suspendsj) 
	       qed
	       
	       from valid_write_sops [OF j_bound'' tssb_j]
	       have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		 by (simp add: split_suspendsj [symmetric] suspendsj)
	       then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		 valid_sops_drop: "sopwrite_sops ys. valid_sop sop"
		 apply (simp only: write_sops_append )
		 apply auto
		 done
	       
	       from read_tmps_distinct [OF j_bound'' tssb_j]
	       have "distinct_read_tmps (?take_sbj@suspendsj)"
		 by (simp add: split_suspendsj [symmetric] suspendsj)
	       then obtain 
		 read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
		 distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		 apply (simp only: split_suspendsj [symmetric] suspendsj) 
		 apply (simp only: distinct_read_tmps_append)
		 done
	       
	       from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]	  
		 last_prog_hd_prog
	       have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
		 by (simp add: split_suspendsj [symmetric] suspendsj) 
	       from reads_consistent_drop_volatile_writes_no_volatile_reads  
	       [OF reads_consis] 
	       have no_vol_read: "outstanding_refs is_volatile_Readsb ys = {}"
		 by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		   split_suspendsj )
	       
	       from flush_store_buffer_append [
		 OF j_bound''''  isj [simplified split_suspendsj] cph [simplified suspendsj]
		 ts_A_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_m_A_ys
		 hist_consis' [simplified split_suspendsj] valid_sops_drop distinct_read_tmps_drop [simplified split_suspendsj] 
		 no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
		 𝒮="?share_A"]
	       obtain isj' j' where
		 isj': "instrs (Writesb True a'' sop' v' A' L' R' W' # zs) @ issbj = 
	            isj' @ prog_instrs (Writesb True a'' sop' v' A' L' R' W' # zs)" and
		 steps_ys: "(?ts_A, ?m_A, ?share_A)  d* 
		(?ts_A[j:= (last_prog (hd_prog pj (Writesb True a'' sop' v' A' L' R' W' # zs)) ys,
                           isj',
                           θsbj |` (dom θsbj - read_tmps (Writesb True a'' sop' v' A' L' R' W' # zs)),(),
		           𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j') ],
                  flush ys ?m_A, share ys ?share_A)"
		 (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
		 by (auto)

	       note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
	       from cph
	       have "causal_program_history issbj ((ys @ [Writesb True a'' sop' v' A' L' R' W']) @ zs)"
		 by simp
	       from causal_program_history_suffix [OF this]
	       have cph': "causal_program_history issbj zs".	      
	       interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

	       from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
	       obtain isj''
		 where isj': "isj' = Write True a'' sop' A' L' R' W'#isj''" and
		 isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
		 by clarsimp
	       
	       from j_bound'''
	       have j_bound_ys: "j < length ?ts_ys"
		 by auto

	       from j_bound_ys neq_i_j
	       have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog pj (Writesb True a'' sop' v' A' L' R' W'# zs)) ys, isj',
                 θsbj |` (dom θsbj - read_tmps (Writesb True a'' sop' v' A' L' R' W'# zs)),(),𝒟j  outstanding_refs is_volatile_Writesb ys  {},
                 acquired True ys (acquired True ?take_sbj 𝒪j),j')"
		 by auto

	       from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	       have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	       from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified isj']
	       have A'_unowned: 
		 "i < length ?ts_ys. ji  (let (𝒪i) = map owned ?ts_ys!i in A'   𝒪i = {})"
		 apply cases
		 apply (fastforce simp add: Let_def issb)+
		 done
	       from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R
	       show False
		 by (auto simp add: Let_def)
	     next
	       assume "A L R W ys zs. 
                 suspendsj = ys @ Ghostsb A L R W # zs  a'  A" 
	       then
	       obtain ys zs A' L' R' W' where
		  split_suspendsj: "suspendsj = ys @ Ghostsb A' L' R' W'# zs" (is "suspendsj = ?suspends") and
		 a'_A': "a'  A'"
		 by auto
		 
	       from direct_memop_step.WriteVolatile [where  θ=θsb and m="flush ?drop_sb m"]
	       have "(Write True a (D, f) A L R W# issb', 
                          θsb, (), flush ?drop_sb m,𝒟sb,acquired True sb 𝒪sb, 
                          release sb (dom 𝒮sb) sb,
                         share ?drop_sb 𝒮)  
                    (issb', θsb, (), (flush ?drop_sb m)(a := f θsb), True, acquired True sb 𝒪sb  A - R, Map.empty, 
                      share ?drop_sb 𝒮W RA L)".

	       from direct_computation.concurrent_step.Memop [OF 
		 i_bound_ts' [simplified issb] ts'_i [simplified issb] this [simplified issb]] 
	       have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) d 
                   (?ts'[i := (psb, issb', 
		         θsb, (), True, acquired True sb 𝒪sb  A - R,Map.empty)], 
                         (flush ?drop_sb m)(a := f θsb),share ?drop_sb 𝒮W RA L)"
		   (is " _ d (?ts_A, ?m_A, ?share_A)")
		 by (simp add: issb)
	      
	       
	       from i_bound' have i_bound'': "i < length ?ts_A"
		 by simp

	       from valid_program_history [OF j_bound'' tssb_j] 
	       have "causal_program_history issbj sbj".
	       then have cph: "causal_program_history issbj ?suspends"
		 apply -
		 apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply (simp add: split_suspendsj)
		 done
	       
	       from tsj neq_i_j j_bound 
	       have ts_A_j: "?ts_A!j = (hd_prog pj (ys @ Ghostsb A' L' R' W'# zs), isj, 
		 θsbj |` (dom θsbj - read_tmps (ys @ Ghostsb A' L' R' W'# zs)), (),𝒟j, 
		 acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
		 by (simp add: split_suspendsj)


	       from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
		 by simp
	       
	       from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
	       then
	       have lp: "last_prog pj ?suspends = pj"
		 apply -
		 apply (rule last_prog_same_append [where sb="?take_sbj"])
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply simp
		 done
	       
	       from valid_reads [OF j_bound'' tssb_j]
	       have reads_consis: "reads_consistent False 𝒪j msb sbj".
	       
	       from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb 
		 j_bound''
		 tssb_j reads_consis]
	       have reads_consis_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		 by (simp add: m suspendsj)
	       
	       from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j tssb_i tssb_j]
	       have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
		 by (simp add: suspendsj)
	       from reads_consistent_flush_independent [OF this reads_consis_m]
	       have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
		 (flush ?drop_sb m) suspendsj".       

	       from a_unowned_others [rule_format, OF _ neq_i_j] j_bound tssb_j
	       obtain a_notin_owns_j: "a  acquired True ?take_sbj 𝒪j" and a_unshared: "a  all_shared ?take_sbj"
	         by auto
	       from a_not_acquired_others [rule_format, OF _ neq_i_j] j_bound tssb_j
	       have a_not_acquired_j: "a  all_acquired sbj"
		 by auto
	       
	       from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' tssb_j]
	       have nvo_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j sbj".

	       have a_no_non_vol_read: "a  outstanding_refs is_non_volatile_Readsb ?drop_sbj"
	       proof 
		 assume a_in_nvr:"a  outstanding_refs is_non_volatile_Readsb ?drop_sbj"
		 
		 from reads_consistent_drop [OF reads_consis]
		 have rc: "reads_consistent True (acquired True ?take_sbj 𝒪j) (flush ?take_sbj msb) ?drop_sbj".

		 from non_volatile_owned_or_read_only_drop [OF nvo_j]
		 have nvo_j_drop: "non_volatile_owned_or_read_only True (share ?take_sbj 𝒮sb)
		   (acquired True ?take_sbj 𝒪j)
		   ?drop_sbj"
		   by simp
		 
		 from outstanding_refs_non_volatile_Readsb_all_acquired [OF rc this a_in_nvr]
		 
		 have a_owns_acq_ror: 
		   "a  𝒪j  all_acquired sbj  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
		   by (auto dest!: acquired_all_acquired_in all_acquired_takeWhile_dropWhile_in
		     simp add: acquired_takeWhile_non_volatile_Writesb)
		 
		 have a_unowned_j: "a  𝒪j  all_acquired sbj"
                 proof (cases "a  𝒪j")
                   case False with a_not_acquired_j show ?thesis by auto
                 next
                   case True
                   from all_shared_acquired_in [OF True a_unshared] a_notin_owns_j
                   have False by auto thus ?thesis ..
                 qed
		 
		 with a_owns_acq_ror 
		 have a_ror: "a  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
		   by auto
		 
		 with read_only_reads_unowned [OF j_bound'' i_bound neq_i_j [symmetric] tssb_j tssb_i]
		 have a_unowned_sb: "a  𝒪sb  all_acquired sb"
		   by auto
		 
		 from sharing_consis [OF j_bound'' tssb_j] sharing_consistent_append [of 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
		 have consis_j_drop: "sharing_consistent (share ?take_sbj 𝒮sb) (acquired True ?take_sbj 𝒪j) ?drop_sbj"
		   by auto
		 
		 from read_only_reads_read_only [OF nvo_j_drop consis_j_drop] a_ror a_unowned_j
		   all_acquired_append [of ?take_sbj ?drop_sbj] acquired_takeWhile_non_volatile_Writesb [of sbj 𝒪j]
		 have "a  read_only (share ?take_sbj 𝒮sb)"
		   by (auto)
		 from read_only_share_all_shared [OF this] a_unshared
		 have "a  read_only 𝒮sb"
		   by fastforce
		 
		 from read_only_unacquired_share [OF read_only_unowned [OF i_bound tssb_i] 
		   weak_sharing_consis [OF i_bound tssb_i] this] a_unowned_sb
		 have "a  read_only (share sb 𝒮sb)"
		   by auto
		 
		 with a_not_ro show False
		   by simp
	       qed
	 
	 
	       with reads_consistent_mem_eq_on_non_volatile_reads  [OF _ subset_refl reads_consis_flush_m]
	       have "reads_consistent True (acquired True ?take_sbj 𝒪j) ?m_A suspendsj"
		 by (auto simp add: suspendsj)
	       

	       hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j) ?m_A ys"
		 by (simp add: split_suspendsj reads_consistent_append)       

	       from valid_history [OF j_bound'' tssb_j]
	       have h_consis: 
		 "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply simp
		 done
	       
	       have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	       proof -
		 from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		   by simp
		 from last_prog_hd_prog_append' [OF h_consis] this
		 have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		   by (simp only: split_suspendsj [symmetric] suspendsj) 
		 moreover 
		 have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		   last_prog (hd_prog pj suspendsj) ?take_sbj"
		   apply (simp only: split_suspendsj [symmetric] suspendsj) 
		   by (rule last_prog_hd_prog_append)
		 ultimately show ?thesis
		   by (simp add: split_suspendsj [symmetric] suspendsj) 
	       qed
	       
	       from valid_write_sops [OF j_bound'' tssb_j]
	       have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		 by (simp add: split_suspendsj [symmetric] suspendsj)
	       then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		   valid_sops_drop: "sopwrite_sops ys. valid_sop sop"
		 apply (simp only: write_sops_append )
		 apply auto
		 done
	       
	       from read_tmps_distinct [OF j_bound'' tssb_j]
	       have "distinct_read_tmps (?take_sbj@suspendsj)"
		 by (simp add: split_suspendsj [symmetric] suspendsj)
	       then obtain 
		 read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
		 distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		 apply (simp only: split_suspendsj [symmetric] suspendsj) 
		 apply (simp only: distinct_read_tmps_append)
		 done
	       
	       from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]	  
		 last_prog_hd_prog
	       have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
		 by (simp add: split_suspendsj [symmetric] suspendsj) 
	       from reads_consistent_drop_volatile_writes_no_volatile_reads  
	       [OF reads_consis] 
	       have no_vol_read: "outstanding_refs is_volatile_Readsb ys = {}"
		 by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		   split_suspendsj )
	   
	       from flush_store_buffer_append [
		 OF j_bound''''  isj [simplified split_suspendsj] cph [simplified suspendsj]
		 ts_A_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_m_A_ys
		 hist_consis' [simplified split_suspendsj] valid_sops_drop distinct_read_tmps_drop [simplified split_suspendsj] 
		 no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
		 𝒮="?share_A"]
	       obtain isj' j' where
		 isj': "instrs (Ghostsb A' L' R' W' # zs) @ issbj = 
	            isj' @ prog_instrs (Ghostsb A' L' R' W'# zs)" and
		 steps_ys: "(?ts_A, ?m_A, ?share_A)  d* 
		(?ts_A[j:= (last_prog (hd_prog pj (Ghostsb A' L' R' W'# zs)) ys,
                           isj',
                           θsbj |` (dom θsbj - read_tmps (Ghostsb A' L' R' W'# zs)),(),
		           𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j') ],
                  flush ys ?m_A,
                  share ys ?share_A)"
		 (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
		 by (auto)

	       note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
	       from cph
	       have "causal_program_history issbj ((ys @ [Ghostsb A' L' R' W']) @ zs)"
		 by simp
	       from causal_program_history_suffix [OF this]
	       have cph': "causal_program_history issbj zs".	      
	       interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

	       from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
	       obtain isj''
		 where isj': "isj' = Ghost A' L' R' W'#isj''" and
		 isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
		 by clarsimp
	       
	       from j_bound'''
	       have j_bound_ys: "j < length ?ts_ys"
		 by auto

	       from j_bound_ys neq_i_j
	       have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog pj (Ghostsb A' L' R' W'# zs)) ys, isj',
                 θsbj |` (dom θsbj - read_tmps (Writesb True a'' sop' v' A' L' R' W'# zs)),(),𝒟j  outstanding_refs is_volatile_Writesb ys  {},
                 acquired True ys (acquired True ?take_sbj 𝒪j),j')"
		 by auto

	       from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	       have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	       from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified isj']
	       have A'_unowned: 
		 "i < length ?ts_ys. ji  (let (𝒪i) = map owned ?ts_ys!i in A'   𝒪i = {})"
		 apply cases
		 apply (fastforce simp add: Let_def issb)+
		 done
	       from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R
	       show False
		 by (auto simp add: Let_def)
	     qed
	   qed
	 qed
       }
       thus ?thesis
	 by (auto simp add: Let_def)
      qed

      have A_no_read_only_reads_by_others:
	  "j<length (map 𝒪_sb tssb). i  j 
             (let (𝒪j, sbj) = map 𝒪_sb tssb! j
             in A  read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j)
	             (dropWhile (Not  is_volatile_Writesb) sbj) = {})"
      proof -
	{
	  fix j 𝒪j sbj
	  assume j_bound: "j < length (map 𝒪_sb tssb)"
	  assume neq_i_j: "ij"
	  assume tssb_j: "(map 𝒪_sb tssb)!j = (𝒪j,sbj)"
	  let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	  let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"

	  assume conflict: "A  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj   {}"
	  have False
	  proof -
	    from j_bound leq
	    have j_bound': "j < length (map owned ts)"
	      by auto
	    from j_bound have j_bound'': "j < length tssb"
	      by auto
	    from j_bound' have j_bound''': "j < length ts"
	      by simp
	    
	    from conflict obtain a' where
	      a'_in: "a'  A" and
              a'_in_j: "a'  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	      by auto


	    from ts_sim [rule_format, OF  j_bound''] tssb_j j_bound''
	    obtain pj suspendsj "issbj" 𝒟sbj 𝒟j j θsbj "isj" where
	      tssb_j: "tssb ! j = (pj,issbj, θsbj, sbj,𝒟sbj,𝒪j,j)" and
	      suspendsj: "suspendsj = ?drop_sbj" and
	      isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	      𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
	      tsj: "ts!j = (hd_prog pj suspendsj, isj,
	             θsbj |` (dom θsbj - read_tmps suspendsj),(), 𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	      apply (cases "tssb!j")
	      apply (force simp add: Let_def)
	      done
	      

	    from split_in_read_only_reads [OF a'_in_j [simplified suspendsj [symmetric]]]
	    obtain t v ys zs where
	      split_suspendsj: "suspendsj = ys @ Readsb False a' t v# zs" (is "suspendsj = ?suspends") and
	      a'_unacq: "a'  acquired True ys (acquired True ?take_sbj 𝒪j)"
	      by blast
	    
	    from direct_memop_step.WriteVolatile [where  θ=θsb and m="flush ?drop_sb m"]
	    have "(Write True a (D, f) A L R W# issb', 
                  θsb, (), flush ?drop_sb m, 𝒟sb,acquired True sb 𝒪sb, 
                  release sb (dom 𝒮sb) sb, share ?drop_sb 𝒮)  
                    (issb', θsb, (), (flush ?drop_sb m)(a := f θsb), True, acquired True sb 𝒪sb  A - R,Map.empty, 
                      share ?drop_sb 𝒮W RA L)".

	    from direct_computation.concurrent_step.Memop [OF 
	      i_bound_ts' [simplified issb] ts'_i [simplified issb] this [simplified issb]] 
	    have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) d 
                    (?ts'[i := (psb, issb', θsb, (), 
                         True, acquired True sb 𝒪sb  A - R,Map.empty)], 
                         (flush ?drop_sb m)(a := f θsb),share ?drop_sb 𝒮W RA L)"
		  (is " _ d (?ts_A, ?m_A, ?share_A)")
	     by (simp add: issb)
	      
	       
	   from i_bound' have i_bound'': "i < length ?ts_A"
	     by simp

	   from valid_program_history [OF j_bound'' tssb_j] 
	   have "causal_program_history issbj sbj".
	   then have cph: "causal_program_history issbj ?suspends"
	     apply -
	     apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
	     apply (simp only: split_suspendsj [symmetric] suspendsj)
	     apply (simp add: split_suspendsj)
	     done
	   
	   from tsj neq_i_j j_bound 
	   have ts_A_j: "?ts_A!j = (hd_prog pj (ys @ Readsb False a' t v# zs), isj,
	     θsbj |` (dom θsbj - read_tmps (ys @ Readsb False a' t v# zs)), (), 𝒟j, 
	     acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	     by (simp add: split_suspendsj)


	   from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
	     by simp

	   from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
	   then
	   have lp: "last_prog pj ?suspends = pj"
	     apply -
	     apply (rule last_prog_same_append [where sb="?take_sbj"])
	     apply (simp only: split_suspendsj [symmetric] suspendsj)
	     apply simp
	     done

	   from valid_reads [OF j_bound'' tssb_j]
	   have reads_consis: "reads_consistent False 𝒪j msb sbj".

	   from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb j_bound''
	     tssb_j reads_consis]
	   have reads_consis_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
	     by (simp add: m suspendsj)

	   from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j tssb_i tssb_j]
	   have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
	     by (simp add: suspendsj)
	   from reads_consistent_flush_independent [OF this reads_consis_m]
	   have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	     (flush ?drop_sb m) suspendsj".

	   from a_unowned_others [rule_format, OF j_bound'' neq_i_j ] j_bound tssb_j
	   obtain a_notin_owns_j: "a  acquired True ?take_sbj 𝒪j" and a_unshared: "a  all_shared ?take_sbj"
	     by auto
	   from a_not_acquired_others [rule_format, OF j_bound neq_i_j] j_bound tssb_j
	   have a_not_acquired_j: "a  all_acquired sbj"
	     by auto
	   
	   from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' tssb_j]
	   have nvo_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j sbj".
	   
	   have a_no_non_vol_read: "a  outstanding_refs is_non_volatile_Readsb ?drop_sbj"
	   proof 
	     assume a_in_nvr:"a  outstanding_refs is_non_volatile_Readsb ?drop_sbj"

	     from reads_consistent_drop [OF reads_consis]
	     have rc: "reads_consistent True (acquired True ?take_sbj 𝒪j) (flush ?take_sbj msb) ?drop_sbj".

	     from non_volatile_owned_or_read_only_drop [OF nvo_j]
	     have nvo_j_drop: "non_volatile_owned_or_read_only True (share ?take_sbj 𝒮sb)
	       (acquired True ?take_sbj 𝒪j)
	       ?drop_sbj"
	       by simp

	     from outstanding_refs_non_volatile_Readsb_all_acquired [OF rc this a_in_nvr]

	     have a_owns_acq_ror: 
	       "a  𝒪j  all_acquired sbj  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	       by (auto dest!: acquired_all_acquired_in all_acquired_takeWhile_dropWhile_in
		 simp add: acquired_takeWhile_non_volatile_Writesb)
             
	     have a_unowned_j: "a  𝒪j  all_acquired sbj"
             proof (cases "a  𝒪j")
               case False with a_not_acquired_j show ?thesis by auto
             next
               case True
               from all_shared_acquired_in [OF True a_unshared] a_notin_owns_j
               have False by auto thus ?thesis ..
             qed
		 
	     with a_owns_acq_ror 
	     have a_ror: "a  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	       by auto

	     with read_only_reads_unowned [OF j_bound'' i_bound neq_i_j [symmetric] tssb_j tssb_i]
	     have a_unowned_sb: "a  𝒪sb  all_acquired sb"
	       by auto
	       
	     from sharing_consis [OF j_bound'' tssb_j] sharing_consistent_append [of 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
	     have consis_j_drop: "sharing_consistent (share ?take_sbj 𝒮sb) (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	       by auto

	     from read_only_reads_read_only [OF nvo_j_drop consis_j_drop] a_ror a_unowned_j
	       all_acquired_append [of ?take_sbj ?drop_sbj] acquired_takeWhile_non_volatile_Writesb [of sbj 𝒪j]
	     have "a  read_only (share ?take_sbj 𝒮sb)"
	       by (auto)
	     from read_only_share_all_shared [OF this] a_unshared
	     have "a  read_only 𝒮sb"
	       by fastforce
	      
	     from read_only_unacquired_share [OF read_only_unowned [OF i_bound tssb_i] 
	       weak_sharing_consis [OF i_bound tssb_i] this] a_unowned_sb
	     have "a  read_only (share sb 𝒮sb)"
	       by auto
	   
	     with a_not_ro show False
	       by simp
	   qed
	 
	   with reads_consistent_mem_eq_on_non_volatile_reads  [OF _ subset_refl reads_consis_flush_m]
	   have "reads_consistent True (acquired True ?take_sbj 𝒪j) ?m_A suspendsj"
	     by (auto simp add: suspendsj)


	   hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j) ?m_A ys"
	     by (simp add: split_suspendsj reads_consistent_append)

	   from valid_history [OF j_bound'' tssb_j]
	   have h_consis: 
	     "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
	     apply (simp only: split_suspendsj [symmetric] suspendsj)
	     apply simp
	     done

	   have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	   proof -
	     from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
	       by simp
	     from last_prog_hd_prog_append' [OF h_consis] this
	     have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
	       by (simp only: split_suspendsj [symmetric] suspendsj) 
	     moreover 
	     have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		  last_prog (hd_prog pj suspendsj) ?take_sbj"
	       apply (simp only: split_suspendsj [symmetric] suspendsj) 
	       by (rule last_prog_hd_prog_append)
	     ultimately show ?thesis
	       by (simp add: split_suspendsj [symmetric] suspendsj) 
	   qed

	   from valid_write_sops [OF j_bound'' tssb_j]
	   have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
	     by (simp add: split_suspendsj [symmetric] suspendsj)
	   then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
	     valid_sops_drop: "sopwrite_sops ys. valid_sop sop"
	     apply (simp only: write_sops_append )
	     apply auto
	     done

	   from read_tmps_distinct [OF j_bound'' tssb_j]
	   have "distinct_read_tmps (?take_sbj@suspendsj)"
	     by (simp add: split_suspendsj [symmetric] suspendsj)
	   then obtain 
	     read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
	     distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
	     apply (simp only: split_suspendsj [symmetric] suspendsj) 
	     apply (simp only: distinct_read_tmps_append)
	     done
	   
	   from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]	  
	     last_prog_hd_prog
	   have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
	     by (simp add: split_suspendsj [symmetric] suspendsj) 
	    from reads_consistent_drop_volatile_writes_no_volatile_reads  
	    [OF reads_consis] 
	    have no_vol_read: "outstanding_refs is_volatile_Readsb ys = {}"
	      by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )
	   
	    from flush_store_buffer_append [
	      OF j_bound''''  isj [simplified split_suspendsj] cph [simplified suspendsj]
	      ts_A_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_m_A_ys
	      hist_consis' [simplified split_suspendsj] valid_sops_drop distinct_read_tmps_drop [simplified split_suspendsj] 
	      no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="?share_A"]
	    obtain isj' j' where
	      isj': "instrs (Readsb False a' t v# zs) @ issbj = 
	            isj' @ prog_instrs (Readsb False a' t v# zs)" and
	      steps_ys: "(?ts_A, ?m_A, ?share_A)  d* 
		(?ts_A[j:= (last_prog (hd_prog pj (Readsb False a' t v# zs)) ys,
                           isj',
                           θsbj |` (dom θsbj - read_tmps (Readsb False a' t v# zs)),(),
                           𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j') ],
                  flush ys ?m_A,
                  share ys ?share_A)"
		 (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
              by (auto)

	    note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
	    from cph
	    have "causal_program_history issbj ((ys @ [Readsb False a' t v]) @ zs)"
	      by simp
	    from causal_program_history_suffix [OF this]
	    have cph': "causal_program_history issbj zs".	      
	    interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

	    from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
	    obtain isj''
	      where isj': "isj' = Read False a' t#isj''" and
	      isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
	      by clarsimp

	    from j_bound'''
	    have j_bound_ys: "j < length ?ts_ys"
	      by auto

	    from j_bound_ys neq_i_j
	    have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog pj (Readsb False a' t v# zs)) ys, isj',
                 θsbj |` (dom θsbj - read_tmps (Readsb False a' t v# zs)),(),
	         𝒟j  outstanding_refs is_volatile_Writesb ys  {},
                 acquired True ys (acquired True ?take_sbj 𝒪j),j')"
	      by auto

	    from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	    have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	    from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified isj']
	    have "a'  acquired True ys (acquired True ?take_sbj 𝒪j) 
                  a'  read_only (share ys (share ?drop_sb 𝒮W RA L))"
	      apply cases
	      apply (auto simp add: Let_def issb)
	      done
	    with a'_unacq
	    have a'_ro: "a'  read_only (share ys (share ?drop_sb 𝒮W RA L))"
	      by auto
	    from a'_in
	    have a'_not_ro: "a'  read_only (share ?drop_sb 𝒮W RA L)"
	      by (auto simp add:  in_read_only_convs)

	    have "a'  𝒪j  all_acquired sbj"
	    proof -
	      {
		assume a_notin: "a'  𝒪j  all_acquired sbj"
		from weak_sharing_consis [OF j_bound'' tssb_j]
		have "weak_sharing_consistent 𝒪j sbj".
		with weak_sharing_consistent_append [of 𝒪j ?take_sbj ?drop_sbj]
		have "weak_sharing_consistent (acquired True ?take_sbj 𝒪j) suspendsj"
		  by (auto simp add: suspendsj)
                
		with split_suspendsj
		have weak_consis: "weak_sharing_consistent (acquired True ?take_sbj 𝒪j) ys"
		  by (simp add: weak_sharing_consistent_append)
		from all_acquired_append [of ?take_sbj ?drop_sbj]
		have "all_acquired ys  all_acquired sbj"
		  apply (clarsimp)
		  apply (clarsimp simp add: suspendsj [symmetric] split_suspendsj all_acquired_append)
		  done

                with a_notin acquired_takeWhile_non_volatile_Writesb [of sbj 𝒪j]
                  all_acquired_append [of ?take_sbj ?drop_sbj]
		have "a'  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j  all_acquired ys"
                  by auto
                
		from read_only_share_unowned [OF weak_consis this a'_ro] 
		have "a'  read_only (share ?drop_sb 𝒮W RA L)" .
		  
		with a'_not_ro have False
		  by auto
	      }
	      thus ?thesis by blast
	    qed
		
	    moreover
	    from A_unaquired_by_others [rule_format, OF j_bound neq_i_j] tssb_j j_bound
	    have "A  all_acquired sbj = {}"
	      by (auto simp add: Let_def)
	    moreover
	    from A_unowned_by_others [rule_format, OF j_bound'' neq_i_j] tssb_j j_bound
	    have "A  𝒪j = {}"
	      by (auto simp add: Let_def dest: all_shared_acquired_in)
	    moreover note a'_in
	    ultimately
	    show False
	      by auto
	  qed
	}
	thus ?thesis
	  by (auto simp add: Let_def)
      qed

      have valid_own': "valid_ownership 𝒮sb' tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	proof -
	  from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i] 
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb (sb @ [Writesb True a (D,f) (f θsb) A L R W]) "
	    by (auto simp add: non_volatile_owned_or_read_only_append)
	  from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	  show ?thesis by (simp add: tssb' sb' 𝒪sb' 𝒮sb')
	qed
      next
	show "outstanding_volatile_writes_unowned_by_others tssb'"
	proof (unfold_locales)
	  fix i1 j p1 "is1" 𝒪1 1 𝒟1 xs1 sb1 pj "isj" "𝒪j" j 𝒟j xsj sbj
	  assume i1_bound: "i1 < length tssb'"
	  assume j_bound: "j < length tssb'"
	  assume i1_j: "i1  j"
	  assume ts_i1: "tssb'!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	  assume ts_j: "tssb'!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb1 = {}"
	  proof (cases "i1=i")
	    case True
	    with i1_j have i_j: "ij" 
	      by simp
	    
	    from j_bound have j_bound': "j < length tssb"
	      by (simp add: tssb')
	    hence j_bound'': "j < length (map owned tssb)"
	      by simp
	    from ts_j i_j have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (simp add: tssb')
	    from a_unowned_others [rule_format, OF _ i_j] i_j ts_j j_bound
	    obtain a_notin_j: "a  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j" and
              a_unshared: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)"
	      by (auto simp add: Let_def tssb')
	    from a_not_acquired_others [rule_format, OF _ i_j] i_j ts_j j_bound
	    have a_notin_acq: "a  all_acquired sbj"
	      by (auto simp add: Let_def tssb')
	    from outstanding_volatile_writes_unowned_by_others 
	    [OF i_bound j_bound' i_j tssb_i ts_j']
	    have "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb = {}".
	    with ts_i1 a_notin_j a_unshared a_notin_acq True i_bound show ?thesis
	      by (auto simp add: tssb' sb' outstanding_refs_append 
		acquired_takeWhile_non_volatile_Writesb dest: all_shared_acquired_in)
	  next
	    case False
	    note i1_i = this
	    from i1_bound have i1_bound': "i1 < length tssb"
	      by (simp add: tssb')
	    from ts_i1 False have ts_i1': "tssb!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	      by (simp add: tssb')
	    show ?thesis
	    proof (cases "j=i")
	      case True

	      from i1_bound'
	      have i1_bound'': "i1 < length (map owned tssb)"
		by simp

	      from outstanding_volatile_writes_unowned_by_others 
	      [OF i1_bound' i_bound i1_i ts_i1' tssb_i]
	      have "(𝒪sb  all_acquired sb)  outstanding_refs is_volatile_Writesb sb1 = {}".
	      moreover
	      from A_unused_by_others [rule_format, OF _ False [symmetric]] False ts_i1 i1_bound
	      have "A  outstanding_refs is_volatile_Writesb sb1 = {}"
		by (auto simp add: Let_def tssb')
	      
	      ultimately
	      show ?thesis
		using ts_j True tssb' 
		by (auto simp add: i_bound tssb' 𝒪sb' sb' all_acquired_append)
	    next
	      case False
	      from j_bound have j_bound': "j < length tssb"
		by (simp add: tssb')
	      from ts_j False have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (simp add: tssb')
	      from outstanding_volatile_writes_unowned_by_others 
              [OF i1_bound' j_bound' i1_j ts_i1' ts_j']
	      show "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb1 = {}" .
	    qed
	  qed
	qed
      next
	show "ownership_distinct tssb'"
	proof -
	  have "j<length tssb. i  j 
	    (let (pj, isj, θj, sbj, 𝒟j, 𝒪j,j) = tssb ! j
	      in (𝒪sb  all_acquired sb')  (𝒪j  all_acquired sbj) = {})"
	  proof -
	    {
	      fix j pj isj 𝒪j j 𝒟j acqj θj sbj
	      assume neq_i_j: "i  j"
	      assume j_bound: "j < length tssb"
	      assume tssb_j: "tssb ! j = (pj, isj, θj, sbj, 𝒟j, 𝒪j,j)"
	      have "(𝒪sb  all_acquired sb')  (𝒪j  all_acquired sbj) = {}"
	      proof -
		{
		  fix a'
		  assume a'_in_i: "a'  (𝒪sb  all_acquired sb')"
		  assume a'_in_j: "a'  (𝒪j  all_acquired sbj)"
		  have False
		  proof -
		    from a'_in_i have "a'  (𝒪sb  all_acquired sb)  a'  A"
		      by (simp add: sb' all_acquired_append)
		    then show False
		    proof 
		      assume "a'  (𝒪sb  all_acquired sb)"
		      with ownership_distinct [OF i_bound j_bound neq_i_j tssb_i tssb_j] a'_in_j
		      show ?thesis
			by auto
		    next
		      assume "a'  A"
		      moreover
		      have j_bound': "j < length (map owned tssb)"
			using j_bound by auto
		      from A_unowned_by_others [rule_format, OF _ neq_i_j] tssb_j j_bound
		      obtain "A  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j = {}" and
                             "A  all_shared (takeWhile (Not  is_volatile_Writesb) sbj) = {}"
			by (auto simp add: Let_def)
		      moreover
		      from A_unaquired_by_others [rule_format, OF _ neq_i_j] tssb_j j_bound
		      have "A  all_acquired sbj = {}"
			by auto
		      ultimately
		      show ?thesis
			using a'_in_j
			by (auto dest: all_shared_acquired_in)
		    qed
		  qed
		}
		then show ?thesis by auto
	      qed
	    }
	    then show ?thesis by (fastforce simp add: Let_def)
	  qed
	
	  from ownership_distinct_nth_update [OF i_bound tssb_i this]
	  show ?thesis by (simp add: tssb' 𝒪sb' sb')
	qed
      next
	show "read_only_reads_unowned tssb'"
	proof 
	  fix n m
	  fix pn "isn" 𝒪n n 𝒟n θn sbn pm "ism" 𝒪m m 𝒟m θm sbm
	  assume n_bound: "n < length tssb'"
	    and m_bound: "m < length tssb'"
	    and neq_n_m: "nm"
	    and nth: "tssb'!n = (pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
	    and mth: "tssb'!m =(pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
	  from n_bound have n_bound': "n < length tssb" by (simp add: tssb')
	  from m_bound have m_bound': "m < length tssb" by (simp add: tssb')
	  
	  show "(𝒪m  all_acquired sbm) 
            read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbn) 𝒪n)
            (dropWhile (Not  is_volatile_Writesb) sbn) =
            {}"
	  proof (cases "m=i")
	    case True
	    with neq_n_m have neq_n_i: "ni"
	      by auto
	    with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
	      by (auto simp add: tssb')
	    note read_only_reads_unowned [OF n_bound' i_bound  neq_n_i nth' tssb_i]
	    moreover
	    from A_no_read_only_reads_by_others [rule_format, OF _ neq_n_i [symmetric]] n_bound' nth'
	    have "A  read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbn) 𝒪n)
              (dropWhile (Not  is_volatile_Writesb) sbn) =
              {}"
	      by auto
	    ultimately 
	    show ?thesis
	      using True tssb_i nth' mth n_bound' m_bound'
	      by (auto simp add: tssb' 𝒪sb' sb' all_acquired_append)
	  next
	    case False
	    note neq_m_i = this
	    with m_bound mth i_bound have mth': "tssb!m = (pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
	      by (auto simp add: tssb')
	    show ?thesis
	    proof (cases "n=i")
	      case True
	      note read_only_reads_unowned [OF i_bound m_bound' neq_m_i [symmetric] tssb_i mth']
	      then show ?thesis
		using True neq_m_i tssb_i nth mth n_bound' m_bound'
		apply (case_tac "outstanding_refs (is_volatile_Writesb) sb = {}")
		apply (clarsimp simp add: outstanding_vol_write_take_drop_appends
		  acquired_append read_only_reads_append tssb' sb' 𝒪sb')+
		done
	    next
	      case False
	      with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
		by (auto simp add: tssb')
	      from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m  nth' mth'] False neq_m_i
	      show ?thesis 
		by (clarsimp)
	    qed
	  qed
	qed
      qed	  

      have valid_hist': "valid_history program_step tssb'"
      proof -
	from valid_history [OF i_bound tssb_i]
	have "history_consistent θsb (hd_prog psb sb) sb".
	with valid_write_sops [OF i_bound tssb_i] D_subset 
	  valid_implies_valid_prog_hd [OF i_bound tssb_i valid]
	have "history_consistent θsb (hd_prog psb (sb@[Writesb True a (D,f) (f θsb) A L R W])) 
	         (sb@ [Writesb True a (D,f) (f θsb) A L R W])"
	  apply -
	  apply (rule history_consistent_appendI)
	  apply (auto simp add: hd_prog_append_Writesb)
	  done
	from valid_history_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' θsb')
      qed

      have valid_reads': "valid_reads msb tssb'"
      proof -
	from valid_reads [OF i_bound tssb_i]
	have "reads_consistent False 𝒪sb msb sb" .
	from reads_consistent_snoc_Writesb [OF this]
	have "reads_consistent False 𝒪sb msb (sb @ [Writesb True a (D,f) (f θsb) A L R W])".
	from valid_reads_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' 𝒪sb')
      qed

      have valid_sharing': "valid_sharing 𝒮sb' tssb'"
      proof (intro_locales)	
	from outstanding_non_volatile_writes_unshared [OF i_bound tssb_i] 
	have "non_volatile_writes_unshared 𝒮sb (sb @ [Writesb True a (D,f) (f θsb) A L R W])"
	  by (auto simp add: non_volatile_writes_unshared_append)
	from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
	show "outstanding_non_volatile_writes_unshared 𝒮sb' tssb'"
	  by (simp add: tssb' sb' 𝒮sb')
      next
	from sharing_consis [OF i_bound tssb_i]
	have consis': "sharing_consistent 𝒮sb 𝒪sb sb".
	from  A_shared_owned
	have "A  dom (share ?drop_sb 𝒮)  acquired True sb 𝒪sb"
	  by (simp add:  sharing_consistent_append  acquired_takeWhile_non_volatile_Writesb)
	moreover have "dom (share ?drop_sb 𝒮)  dom 𝒮  dom (share sb 𝒮sb)"
	proof
	  fix a'
	  assume a'_in: "a'  dom (share ?drop_sb 𝒮)" 
	  from share_unshared_in [OF a'_in]
	  show "a'  dom 𝒮  dom (share sb 𝒮sb)"
	  proof 
	    assume "a'  dom (share ?drop_sb Map.empty)" 
	    from share_mono_in [OF this] share_append [of ?take_sb ?drop_sb]
	    have "a'  dom (share sb 𝒮sb)"
	      by auto
	    thus ?thesis
	      by simp
	  next
	    assume "a'  dom 𝒮  a'  all_unshared ?drop_sb"
	    thus ?thesis by auto
	  qed
	qed
	ultimately
	have A_subset: "A  dom 𝒮  dom (share sb 𝒮sb)  acquired True sb 𝒪sb"
	  by auto

        with A_unowned_by_others 
        
        have "A  dom (share sb 𝒮sb)  acquired True sb 𝒪sb"
        proof -
          {
            fix x
            assume x_A: "x  A"
            have "x  dom (share sb 𝒮sb)  acquired True sb 𝒪sb"
            proof -
              {
                assume "x  dom 𝒮"
                
                from share_all_until_volatile_write_share_acquired [OF ‹sharing_consis 𝒮sb tssb 
                  i_bound tssb_i this [simplified 𝒮]]
                  A_unowned_by_others x_A
                have ?thesis
                by (fastforce simp add: Let_def)
             }
             with A_subset show ?thesis using x_A by auto
           qed
         }
         thus ?thesis by blast
        qed
	with consis' L_subset A_R R_acq
	have "sharing_consistent 𝒮sb 𝒪sb (sb @ [Writesb True a (D,f) (f θsb) A L R W])"
	  by (simp add:  sharing_consistent_append  acquired_takeWhile_non_volatile_Writesb)
	from sharing_consis_nth_update [OF i_bound this]
	show "sharing_consis 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒪sb' sb' 𝒮sb')
      next
	from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound tssb_i] ]
	show "read_only_unowned 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' 𝒪sb')
      next
	from unowned_shared_nth_update [OF i_bound tssb_i subset_refl]
	show "unowned_shared 𝒮sb' tssb'"
	  by (simp add: tssb' sb' 𝒪sb' 𝒮sb')
      next
	from a_not_ro no_outstanding_write_to_read_only_memory [OF i_bound tssb_i] 
	have "no_write_to_read_only_memory 𝒮sb (sb @ [Writesb True a (D,f) (f θsb) A L R W])"
	  by (simp add: no_write_to_read_only_memory_append)
	
	from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
	show "no_outstanding_write_to_read_only_memory 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' sb')
      qed

      have tmps_distinct': "tmps_distinct tssb'"
      proof (intro_locales)
	from load_tmps_distinct [OF i_bound tssb_i]
	have "distinct_load_tmps issb'" by (simp add: "issb")
	from load_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_distinct tssb'" by (simp add: tssb')
      next
	from read_tmps_distinct [OF i_bound tssb_i]
	have "distinct_read_tmps (sb @ [Writesb True a (D, f) (f θsb) A L R W])"
	  by (auto simp add: distinct_read_tmps_append)
	from read_tmps_distinct_nth_update [OF i_bound this]
	show "read_tmps_distinct tssb'" by (simp add: tssb' sb')
      next
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i]
	have "load_tmps issb'  read_tmps (sb @ [Writesb True a (D, f) (f θsb) A L R W]) ={}"
	  by (auto simp add: read_tmps_append "issb")
	from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_read_tmps_distinct tssb'" by (simp add: tssb' sb')
      qed
      
      have valid_sops': "valid_sops tssb'"
      proof -
	from valid_store_sops [OF i_bound tssb_i]
	obtain valid_Df: "valid_sop (D,f)" and  
	  valid_store_sops': "sopstore_sops issb'. valid_sop sop"
	  by (auto simp add: "issb")
	from valid_Df valid_write_sops [OF i_bound tssb_i]
	have valid_write_sops': "sopwrite_sops (sb@ [Writesb True a (D, f) (f θsb) A L R W]). 
	  valid_sop sop"
	  by (auto simp add: write_sops_append)
	from valid_sops_nth_update [OF i_bound  valid_write_sops' valid_store_sops']
	show ?thesis by (simp add: tssb' sb')
      qed

      have valid_dd': "valid_data_dependency tssb'"
      proof -
	from data_dependency_consistent_instrs [OF i_bound tssb_i]
	obtain D_indep: "D  load_tmps issb' = {}" and 
	  dd_is: "data_dependency_consistent_instrs (dom θsb') issb'"
	  by (auto simp add: "issb" θsb')
	from load_tmps_write_tmps_distinct [OF i_bound tssb_i] D_indep
	have "load_tmps issb'  (fst ` write_sops (sb@ [Writesb True a (D, f) (f θsb) A L R W])) ={}"
	  by (auto simp add: write_sops_append "issb")
	from valid_data_dependency_nth_update [OF i_bound dd_is this]
	show ?thesis by (simp add: tssb' sb')
      qed

      have load_tmps_fresh': "load_tmps_fresh tssb'"
      proof -
	from load_tmps_fresh [OF i_bound tssb_i] 
	have "load_tmps issb'  dom θsb = {}"
	  by (auto simp add: "issb")
	from load_tmps_fresh_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' θsb')
      qed

      have enough_flushs': "enough_flushs tssb'"
      proof -
	from clean_no_outstanding_volatile_Writesb [OF i_bound tssb_i]
	have "¬ True  outstanding_refs is_volatile_Writesb (sb@[Writesb True a (D,f) (f θsb) A L R W]) = {}"
	  by (auto simp add: outstanding_refs_append )
	from enough_flushs_nth_update [OF i_bound this]
	show ?thesis
	  by (simp add: tssb' sb' 𝒟sb')
      qed

      have valid_program_history': "valid_program_history tssb'"
      proof -	
	from valid_program_history [OF i_bound tssb_i]
	have "causal_program_history issb sb" .
	then have causal': "causal_program_history issb' (sb@[Writesb True a (D,f) (f θsb) A L R W])"
	  by (auto simp: causal_program_history_Write  "issb")
	from valid_last_prog [OF i_bound tssb_i]
	have "last_prog psb sb = psb".
	hence "last_prog psb (sb @ [Writesb True a (D,f) (f θsb) A L R W]) = psb"
	  by (simp add: last_prog_append_Writesb)
	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb' sb')
      qed

      show ?thesis
      proof (cases "outstanding_refs is_volatile_Writesb sb = {}")
	case True
	
	from True have flush_all: "takeWhile (Not  is_volatile_Writesb) sb = sb"
	  by (auto simp add: outstanding_refs_conv)
	
	from True have suspend_nothing: "dropWhile (Not  is_volatile_Writesb) sb = []"
	  by (auto simp add: outstanding_refs_conv)

	hence suspends_empty: "suspends = []"
	  by (simp add: suspends)

	from suspends_empty is_sim have "is": "is = Write True a (D,f) A L R W# issb'"
	  by (simp add: "issb")
	with suspends_empty ts_i 
	have ts_i: "ts!i = (psb, Write True a (D,f) A L R W# issb', θsb,(),𝒟, acquired True ?take_sb 𝒪sb, release ?take_sb (dom 𝒮sb) sb)"
	  by simp

	have "(ts, m, 𝒮) d* (ts, m, 𝒮)" by auto

	moreover
	
	note flush_commute =
	  flush_all_until_volatile_write_append_volatile_write_commute 
	[OF True i_bound tssb_i]


	from True 
	have drop_app: "dropWhile (Not  is_volatile_Writesb) 
	  (sb@[Writesb True a (D,f) (f θsb) A L R W]) =
          [Writesb True a (D,f) (f θsb) A L R W]"
	  by (auto simp add: outstanding_refs_conv)

	have "(tssb',msb,𝒮sb')  (ts,m,𝒮)"
	  apply (rule sim_config.intros) 
	  apply    (simp add: m flush_commute tssb' θsb' 𝒪sb' ℛsb' sb') 	  
	  using  share_all_until_volatile_write_Write_commute 
	          [OF i_bound tssb_i [simplified issb]]
	  apply   (clarsimp simp add: 𝒮 𝒮sb' tssb' sb' 𝒪sb' ℛsb' θsb')
	  using  leq
	  apply  (simp add: tssb')
	  using i_bound i_bound' ts_sim ts_i 
	  apply (clarsimp simp add: Let_def nth_list_update drop_app (* drop*) 
	    tssb' sb' 𝒪sb' ℛsb' 𝒮sb' θsb' 𝒟sb'  outstanding_refs_append takeWhile_tail flush_all
	    split: if_split_asm )
	  done

	ultimately show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' 
	    valid_sops'
            valid_dd' load_tmps_fresh' enough_flushs' 
	    valid_program_history' valid' msb' 𝒮sb'
	  by auto
      next
	case False

	then obtain r where r_in: "r  set sb" and volatile_r: "is_volatile_Writesb r"
	  by (auto simp add: outstanding_refs_conv)
	from takeWhile_dropWhile_real_prefix 
	[OF r_in, of  "(Not  is_volatile_Writesb)", simplified, OF volatile_r] 
	obtain a' v' sb'' A'' L'' R'' W'' sop' where
	  sb_split: "sb = takeWhile (Not  is_volatile_Writesb) sb @ Writesb True a' sop' v' A'' L'' R'' W''# sb''" 
	  and
	  drop: "dropWhile (Not  is_volatile_Writesb) sb = Writesb True a' sop' v' A'' L'' R'' W''# sb''"
	  apply (auto)
    subgoal for y ys
	  apply (case_tac y)
	  apply auto
	  done
	  done
	from drop suspends have suspends: "suspends = Writesb True a' sop' v' A'' L'' R'' W''# sb''"
	  by simp

	have "(ts, m, 𝒮) d* (ts, m, 𝒮)" by auto
	
	moreover

	note flush_commute =
	  flush_all_until_volatile_write_append_unflushed [OF False i_bound tssb_i]

	have "Writesb True a' sop' v' A'' L'' R'' W''  set sb"
	  by (subst sb_split) auto
	note drop_app = dropWhile_append1 
	[OF this, of "(Not  is_volatile_Writesb)", simplified]

	have "(tssb',msb,𝒮sb')  (ts,m,𝒮)"
	  apply (rule sim_config.intros) 
	  apply    (simp add: m flush_commute tssb' 𝒪sb' ℛsb' θsb' sb')
	  using  share_all_until_volatile_write_Write_commute 
	          [OF i_bound tssb_i [simplified issb]]
	  apply   (clarsimp simp add: 𝒮 𝒮sb' tssb' sb' 𝒪sb' ℛsb' θsb')
	  using  leq
	  apply  (simp add: tssb')
	  using i_bound i_bound' ts_sim ts_i is_sim 
	  apply (clarsimp simp add: Let_def nth_list_update is_sim drop_app
	    read_tmps_append suspends 
	    prog_instrs_append_Writesb instrs_append_Writesb hd_prog_append_Writesb
	    drop "issb" tssb' sb' 𝒪sb' 𝒮sb' ℛsb' θsb' 𝒟sb' outstanding_refs_append takeWhile_tail release_append split: if_split_asm)
	  done
	ultimately show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_dd'
	    valid_sops' load_tmps_fresh' enough_flushs' 
	    valid_program_history' valid' msb' 𝒮sb' 
	  by (auto simp del: fun_upd_apply )
      qed
    next
      case SBHFence
      then obtain 
	"issb": "issb = Fence # issb'" and
	sb: "sb=[]" and
	𝒪sb': "𝒪sb'=𝒪sb" andsb': "sb'=Map.empty" and
	θsb': "θsb' = θsb" and
	𝒟sb': "¬ 𝒟sb'" and
	sb': "sb'=sb" and
	msb': "msb' = msb" and
	𝒮sb': "𝒮sb'=𝒮sb" 
	by auto

      have valid_own': "valid_ownership 𝒮sb' tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	proof -
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb []"
	    by simp
	  from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	  show ?thesis by (simp add: tssb' sb' sb 𝒪sb' 𝒮sb')
	qed
      next
	from outstanding_volatile_writes_unowned_by_others_store_buffer 
	[OF i_bound tssb_i subset_refl]
	show "outstanding_volatile_writes_unowned_by_others tssb'" 
	  by (simp add: tssb' sb' sb 𝒪sb')
      next
	from read_only_reads_unowned_nth_update [OF i_bound tssb_i, of "[]" 𝒪sb]
	show "read_only_reads_unowned tssb'"
	  by (simp add: tssb' sb' sb 𝒪sb')
      next
	from ownership_distinct_instructions_read_value_store_buffer_independent 
	[OF i_bound tssb_i]
	show "ownership_distinct tssb'"
	  by (simp add: tssb' sb' sb 𝒪sb')
      qed


      have valid_hist': "valid_history program_step tssb'"
      proof -
	from valid_history [OF i_bound tssb_i] 
	have "history_consistent θsb (hd_prog psb []) []" by simp
	from valid_history_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' sb 𝒪sb' θsb')
      qed
      
      have valid_reads': "valid_reads msb tssb'"
      proof -
	have "reads_consistent False 𝒪sb msb []" by simp
	from valid_reads_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' sb 𝒪sb')
      qed


      have valid_sharing': "valid_sharing 𝒮sb' tssb'"
      proof (intro_locales)
	have "non_volatile_writes_unshared 𝒮sb []" 
	  by (simp add: sb)
	from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
	show "outstanding_non_volatile_writes_unshared 𝒮sb' tssb'"
	  by (simp add: tssb' sb sb' 𝒮sb')
      next
	have "sharing_consistent 𝒮sb 𝒪sb []" by simp
	from sharing_consis_nth_update [OF i_bound this]
	show "sharing_consis 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒪sb' sb' sb 𝒮sb')
      next
	from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound tssb_i] ]
	show "read_only_unowned 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' 𝒪sb')
      next
	from unowned_shared_nth_update [OF i_bound tssb_i subset_refl]
	show "unowned_shared 𝒮sb' tssb'" by (simp add: tssb' sb' sb 𝒪sb' 𝒮sb') 
      next
	from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound, of "[]"]
	show "no_outstanding_write_to_read_only_memory 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' sb' sb)
      qed

      have tmps_distinct': "tmps_distinct tssb'"
      proof (intro_locales)
	from load_tmps_distinct [OF i_bound tssb_i]
	have "distinct_load_tmps issb'" 
	  by (auto simp add: "issb" split: instr.splits)
	from load_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_distinct tssb'" by (simp add: tssb' sb' sb 𝒪sb' "issb")
      next
	from read_tmps_distinct [OF i_bound tssb_i]
	have "distinct_read_tmps []" by (simp add: tssb' sb' sb 𝒪sb')
	from read_tmps_distinct_nth_update [OF i_bound this]
	show "read_tmps_distinct tssb'" by (simp add: tssb' sb' sb 𝒪sb')
      next
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i] 
          load_tmps_distinct [OF i_bound tssb_i]
	have "load_tmps issb'  read_tmps [] = {}"
	  by (clarsimp)
	from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_read_tmps_distinct tssb'"  by (simp add: tssb' sb' sb 𝒪sb')
      qed

      have valid_sops': "valid_sops tssb'"
      proof -
	from valid_store_sops [OF i_bound tssb_i]
	obtain 
	  valid_store_sops': "sopstore_sops issb'. valid_sop sop"
	  by (auto simp add: "issb" tssb' sb' sb 𝒪sb')

	from valid_sops_nth_update [OF i_bound  _ valid_store_sops', where sb= "[]" ]
	show ?thesis by (auto simp add: tssb' sb' sb 𝒪sb')
      qed

      have valid_dd': "valid_data_dependency tssb'"
      proof -
	from data_dependency_consistent_instrs [OF i_bound tssb_i]
	obtain 
	  dd_is: "data_dependency_consistent_instrs (dom θsb') issb'"
	  by (auto simp add: "issb" θsb')
	from load_tmps_write_tmps_distinct [OF i_bound tssb_i] 
	have "load_tmps issb'  (fst ` write_sops [])  = {}"
	  by (auto simp add: write_sops_append)
	from valid_data_dependency_nth_update [OF i_bound dd_is this]
	show ?thesis by (simp add: tssb' sb' sb 𝒪sb')
      qed

      have load_tmps_fresh': "load_tmps_fresh tssb'"
      proof -
	from load_tmps_fresh [OF i_bound tssb_i] 
	have "load_tmps issb'  dom θsb = {}"
	  by (auto simp add: "issb")
	from load_tmps_fresh_nth_update [OF i_bound this]
	show ?thesis by (simp add: "issb" tssb' sb' sb θsb')
      qed


      from enough_flushs_nth_update [OF i_bound, where sb="[]" ]
      have enough_flushs': "enough_flushs tssb'"
	by (auto simp add: tssb' sb' sb)

      have valid_program_history': "valid_program_history tssb'"
      proof -	
	have causal': "causal_program_history issb' sb'"
	  by (simp add: "issb" sb sb')
	have "last_prog psb sb' = psb"
	  by (simp add: sb' sb)
	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb' sb')
      qed

      from is_sim have "is": "is = Fence # issb'"
	by (simp add: suspends sb "issb")
      with ts_i 
      have ts_i: "ts!i = (psb, Fence # issb', θsb,(), 𝒟, acquired True ?take_sb 𝒪sb, release ?take_sb (dom 𝒮sb) sb)"
	by (simp add: suspends sb)

      from direct_memop_step.Fence 
      have "(Fence # issb',
	    θsb, (),m,𝒟, acquired True ?take_sb 𝒪sb, release ?take_sb (dom 𝒮sb) sb, 𝒮)  
        (issb', θsb, (), m, False, acquired True ?take_sb 𝒪sb, Map.empty, 𝒮)".
      from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this] 
      have "(ts, m, 𝒮) d 
        (ts[i := (psb, issb', θsb, (), False, acquired True ?take_sb 𝒪sb,Map.empty)], m, 𝒮)".

      moreover

      have "(tssb',msb,𝒮sb')  (ts[i := (psb,issb', θsb,(), False,acquired True ?take_sb 𝒪sb,Map.empty)],m,𝒮)"
	apply (rule sim_config.intros) 
	apply    (simp add: tssb' sb' 𝒪sb' ℛsb' 𝒮sb' m 
	  flush_all_until_volatile_nth_update_unused [OF i_bound tssb_i])
	using   share_all_until_volatile_write_Fence_commute 
	           [OF i_bound tssb_i [simplified issb sb]]
	apply  (clarsimp simp add: 𝒮 tssb' 𝒮sb' issb 𝒪sb' ℛsb' θsb' sb' sb)
	using  leq
	apply  (simp add: tssb')
	using i_bound i_bound' ts_sim 
	apply (clarsimp simp add: Let_def nth_list_update 
	  tssb' sb' sb 𝒪sb' ℛsb' 𝒮sb' 𝒟sb' ex_not  θsb'
	  split: if_split_asm ) 
	done
      ultimately 
      show ?thesis
	using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_sops'
	  valid_dd' load_tmps_fresh' enough_flushs' 
	  valid_program_history' valid' msb' 𝒮sb' 
	by (auto simp del: fun_upd_apply)
    next	
      case (SBHRMWReadOnly cond t a D f ret A L R W)
      then obtain 
	"issb": "issb = RMW a t (D,f) cond ret A L R W # issb'" and
	cond: "¬ (cond (θsb(tmsb a)))" and
	𝒪sb': "𝒪sb'=𝒪sb" andsb': "sb'=Map.empty" and
	θsb': "θsb' = θsb(tmsb a)" and
	𝒟sb': "¬ 𝒟sb'" and
	sb: "sb=[]" and
	sb': "sb'=[]" and
	msb': "msb' = msb" and
	𝒮sb': "𝒮sb'=𝒮sb" 
	by auto

      from safe_RMW_common  [OF safe_memop_flush_sb [simplified issb]]
      obtain access_cond: "a  𝒪sb  a  dom 𝒮" and
      rels_cond: " j < length ts. ij  released (ts!j) a  Some False"
        by (auto simp add: 𝒮 sb)
	

      have valid_own': "valid_ownership 𝒮sb' tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	proof -
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb []"
	    by simp
	  from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	  show ?thesis by (simp add: tssb' sb' sb 𝒪sb' 𝒮sb')
	qed
      next
	from outstanding_volatile_writes_unowned_by_others_store_buffer 
	[OF i_bound tssb_i subset_refl]
	show "outstanding_volatile_writes_unowned_by_others tssb'" 
	  by (simp add: tssb' sb' sb 𝒪sb' 𝒮sb')
      next
	from read_only_reads_unowned_nth_update [OF i_bound tssb_i, of "[]" 𝒪sb]
	show "read_only_reads_unowned tssb'"
	  by (simp add: tssb' sb' sb 𝒪sb')
      next
	from ownership_distinct_instructions_read_value_store_buffer_independent 
	[OF i_bound tssb_i]
	show "ownership_distinct tssb'"
	  by (simp add: tssb' sb' sb 𝒪sb')
      qed


      have valid_hist': "valid_history program_step tssb'"
      proof -
	from valid_history [OF i_bound tssb_i] 
	have "history_consistent (θsb(tmsb a)) (hd_prog psb []) []" by simp
	from valid_history_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' sb 𝒪sb' θsb')
      qed
      
      have valid_reads': "valid_reads msb tssb'"
      proof -
	have "reads_consistent False 𝒪sb msb []" by simp
	from valid_reads_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' sb 𝒪sb')
      qed


      have valid_sharing': "valid_sharing 𝒮sb' tssb'"
      proof (intro_locales)
	from outstanding_non_volatile_writes_unshared [OF i_bound tssb_i]
	have "non_volatile_writes_unshared 𝒮sb []" 
	  by (simp add: sb)
	from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
	show "outstanding_non_volatile_writes_unshared 𝒮sb' tssb'"
	  by (simp add: tssb' sb sb' 𝒮sb')
      next
	have "sharing_consistent 𝒮sb 𝒪sb []" by simp
	from sharing_consis_nth_update [OF i_bound this]
	show "sharing_consis 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒪sb' sb' sb 𝒮sb')
      next
	from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound tssb_i] ]
	show "read_only_unowned 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' 𝒪sb')
      next
	from unowned_shared_nth_update [OF i_bound tssb_i subset_refl]
	show "unowned_shared 𝒮sb' tssb'" by (simp add: tssb' sb' sb 𝒪sb' 𝒮sb')
      next 
	from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound, of "[]"]
	show "no_outstanding_write_to_read_only_memory 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' sb' sb)
      qed

      have tmps_distinct': "tmps_distinct tssb'"
      proof (intro_locales)
	from load_tmps_distinct [OF i_bound tssb_i]
	have "distinct_load_tmps issb'" 
	  by (auto simp add: "issb" split: instr.splits)
	from load_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_distinct tssb'" by (simp add: tssb' sb' sb 𝒪sb' "issb")
      next
	from read_tmps_distinct [OF i_bound tssb_i]
	have "distinct_read_tmps []" by (simp add: tssb' sb' sb 𝒪sb')
	from read_tmps_distinct_nth_update [OF i_bound this]
	show "read_tmps_distinct tssb'" by (simp add: tssb' sb' sb 𝒪sb')
      next
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i] 
          load_tmps_distinct [OF i_bound tssb_i]
	have "load_tmps issb'  read_tmps [] = {}"
	  by (clarsimp)
	from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_read_tmps_distinct tssb'"  by (simp add: tssb' sb' sb 𝒪sb')
      qed

      have valid_sops': "valid_sops tssb'"
      proof -
	from valid_store_sops [OF i_bound tssb_i]
	obtain 
	  valid_store_sops': "sopstore_sops issb'. valid_sop sop"
	  by (auto simp add: "issb" tssb' sb' sb 𝒪sb')

	from valid_sops_nth_update [OF i_bound  _ valid_store_sops', where sb= "[]" ]
	show ?thesis by (auto simp add: tssb' sb' sb 𝒪sb')
      qed

      have valid_dd': "valid_data_dependency tssb'"
      proof -
	from data_dependency_consistent_instrs [OF i_bound tssb_i]
	obtain 
	  dd_is: "data_dependency_consistent_instrs (dom θsb') issb'"
	  by (auto simp add: "issb" θsb')
	from load_tmps_write_tmps_distinct [OF i_bound tssb_i] 
	have "load_tmps issb'  (fst ` write_sops [])  = {}"
	  by (auto simp add: write_sops_append)
	from valid_data_dependency_nth_update [OF i_bound dd_is this]
	show ?thesis by (simp add: tssb' sb' sb 𝒪sb')
      qed


      have load_tmps_fresh': "load_tmps_fresh tssb'"
      proof -
	from load_tmps_fresh [OF i_bound tssb_i] 
	have "load_tmps (RMW a t (D,f) cond ret A L R W# issb')  dom θsb = {}"
	  by (simp add: "issb")
	moreover
	from load_tmps_distinct [OF i_bound tssb_i] have "t  load_tmps issb'"
	  by (auto simp add: "issb")
	ultimately have "load_tmps issb'  dom (θsb(t  msb a)) = {}"
	  by auto
	from load_tmps_fresh_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' θsb')
      qed

      from enough_flushs_nth_update [OF i_bound, where sb="[]" ]
      have enough_flushs': "enough_flushs tssb'"
	by (auto simp add: tssb' sb' sb)

      have valid_program_history': "valid_program_history tssb'"
      proof -	
	have causal': "causal_program_history issb' sb'"
	  by (simp add: "issb" sb sb')
	have "last_prog psb sb' = psb"
	  by (simp add: sb' sb)
	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb' sb')
      qed

      from is_sim have "is": "is = RMW a t (D,f) cond ret A L R W# issb'"
	by (simp add: suspends sb "issb")
      with ts_i 
      have ts_i: "ts!i = (psb, RMW a t (D,f) cond ret A L R W# issb', θsb,(), 
	𝒟, acquired True ?take_sb 𝒪sb, release ?take_sb (dom 𝒮sb) sb)"
	by (simp add: suspends sb)
      
	
      have "flush_all_until_volatile_write tssb msb a = msb a"
      proof -
        have "j < length tssb. i  j 
          (let (_,_,_,sbj,_,_,_) = tssb!j 
          in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))"
	proof -
	  {
	    fix j pj "isj" 𝒪j j 𝒟j xsj sbj
	    assume j_bound: "j < length tssb"
	    assume neq_i_j: "i  j"
	    assume jth: "tssb!j = (pj,isj, xsj, sbj, 𝒟j, 𝒪j,j)"
	    have "a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	    proof 
	      let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	      let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"
	      assume a_in: "a  outstanding_refs is_non_volatile_Writesb ?take_sbj"
	      with outstanding_refs_takeWhile [where P'= "Not  is_volatile_Writesb"]
	      have a_in': "a  outstanding_refs is_non_volatile_Writesb sbj"
		by auto
	      with non_volatile_owned_or_read_only_outstanding_non_volatile_writes 
	      [OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]]
	      have j_owns: "a  𝒪j  all_acquired sbj"
		by auto
              from rels_cond [rule_format, OF j_bound [simplified leq] neq_i_j] ts_sim [rule_format, OF j_bound] jth
              have no_unsharing:"release ?take_sbj (dom (𝒮sb)) j  a  Some False"
                by (auto simp add: Let_def)
	      from access_cond
	      show False
	      proof 
		assume "a  𝒪sb"
		with ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth] 
		  j_owns 
		show False
		  by auto
	      next
		assume a_shared: "a  dom 𝒮"
                with share_all_until_volatile_write_thread_local [OF ownership_distinct_tssb sharing_consis_tssb j_bound jth j_owns]
                have a_dom: "a  dom  (share ?take_sbj 𝒮sb)"
                  by (auto simp add: 𝒮 domIff)
		from outstanding_non_volatile_writes_unshared [OF j_bound jth]
		have "non_volatile_writes_unshared 𝒮sb sbj".
		with non_volatile_writes_unshared_append [of 𝒮sb "(takeWhile (Not  is_volatile_Writesb) sbj)"
		  "(dropWhile (Not  is_volatile_Writesb) sbj)"]
		have unshared_take: "non_volatile_writes_unshared 𝒮sb (takeWhile (Not  is_volatile_Writesb) sbj)" 
		  by clarsimp

                from release_not_unshared_no_write_take [OF  unshared_take no_unsharing a_dom] a_in
                show False by auto
	      qed
	    qed
	  } 
	  thus ?thesis
	    by (fastforce simp add: Let_def)
	qed

	from flush_all_until_volatile_write_buffered_val_conv 
	[OF _ i_bound tssb_i this]
	show ?thesis
	  by (simp add: sb)
      qed
      
      hence m_a: "m a = msb a"
	by (simp add: m)

      from cond have cond': "¬ cond (θsb(t  m a))"
	by (simp add: m_a)

      from direct_memop_step.RMWReadOnly [where cond=cond and θ=θsb and m=m, OF cond']
      have "(RMW a t (D, f) cond ret A L R W # issb',
             θsb, (),m, 𝒟, 𝒪sb, sb, 𝒮)  
            (issb', θsb(t  m a), (), m, False, 𝒪sb, Map.empty, 𝒮)".

      from direct_computation.concurrent_step.Memop [OF i_bound' ts_i [simplified sb, simplified] this]
      have "(ts, m, 𝒮) d (ts[i := (psb, issb',
	       θsb(t  m a), (), False, 𝒪sb,Map.empty)], m, 𝒮)".

      moreover
      
      have tmps_commute: "θsb(t  (msb a)) = 
	(θsb |` (dom θsb - {t}))(t  (msb a))"
	apply (rule ext)
	apply (auto simp add: restrict_map_def domIff)
	done

      have "(tssb',msb,𝒮sb')  (ts[i := (psb,issb', θsb(t  m a),(), False,𝒪sb,Map.empty)],m,𝒮)"
	apply (rule sim_config.intros)
	apply    (simp add: tssb' sb' 𝒪sb' ℛsb' m 
	  flush_all_until_volatile_nth_update_unused [OF i_bound tssb_i, simplified sb])
	using  share_all_until_volatile_write_RMW_commute [OF i_bound tssb_i [simplified issb sb]]
	apply  (clarsimp simp add: 𝒮 tssb' 𝒮sb' issb 𝒪sb' θsb' sb' sb)
	using  leq
	apply  (simp add: tssb')
	using i_bound i_bound' ts_sim
	apply (clarsimp simp add: Let_def nth_list_update 
	  tssb' sb' sb 𝒪sb' ℛsb' 𝒮sb' θsb' 𝒟sb' ex_not m_a
	  split: if_split_asm)
	apply (rule tmps_commute)
	done
      ultimately 
      show ?thesis
	using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_sops'
	  valid_dd' load_tmps_fresh' enough_flushs' 
	  valid_program_history' valid' msb' 𝒮sb' 
	by (auto simp del: fun_upd_apply)
    next
      case (SBHRMWWrite cond t a D f ret A L R W) 
      then obtain 
	"issb": "issb = RMW a t (D,f) cond ret A L R W # issb'" and
	cond: "(cond (θsb(tmsb a)))" and
	𝒪sb': "𝒪sb'=𝒪sb  A - R" andsb': "sb'=Map.empty" and
	𝒟sb': "¬ 𝒟sb'" and
	θsb': "θsb' = θsb(tret (msb a) (f (θsb(tmsb a))))" and
	sb: "sb=[]" and
	sb': "sb'=[]" and
	msb': "msb' = msb(a := f (θsb(tmsb a)))" and
	𝒮sb': "𝒮sb'=𝒮sbW RA L" 
	by auto

      from data_dependency_consistent_instrs [OF i_bound tssb_i]
      have D_subset: "D  dom θsb" 
	by (simp add: issb)

      from is_sim have "is": "is = RMW a t (D,f) cond ret A L R W # issb'"
	by (simp add: suspends sb "issb")
      with ts_i 
      have ts_i: "ts!i = (psb, RMW a t (D,f) cond ret A L R W # issb', θsb,(), 𝒟, 𝒪sb,sb)"
	by (simp add: suspends sb)
      
      from safe_RMW_common  [OF safe_memop_flush_sb [simplified issb]]
      obtain access_cond: "a  𝒪sb  a  dom 𝒮" and
      rels_cond: " j < length ts. ij  released (ts!j) a  Some False"
        by (auto simp add: 𝒮 sb)



      have a_unflushed: 
	"j < length tssb. i  j 
                  (let (_,_,_,sbj,_,_,_) = tssb!j 
                  in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))"
      proof -
	{
	  fix j pj "isj" 𝒪j j 𝒟j xsj sbj
	  assume j_bound: "j < length tssb"
	  assume neq_i_j: "i  j"
	  assume jth: "tssb!j = (pj,isj, xsj, sbj, 𝒟j, 𝒪j, j)"
	  have "a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	  proof 
	    let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	    let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"
	    assume a_in: "a  outstanding_refs is_non_volatile_Writesb ?take_sbj"
	    with outstanding_refs_takeWhile [where P'= "Not  is_volatile_Writesb"]
	    have a_in': "a  outstanding_refs is_non_volatile_Writesb sbj"
	      by auto
	    with non_volatile_owned_or_read_only_outstanding_non_volatile_writes 
	    [OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]]
	    have j_owns: "a  𝒪j  all_acquired sbj"
	      by auto
	    with ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth]
	    have a_not_owns: "a  𝒪sb  all_acquired sb"
	      by blast
	    assume a_in: "a  outstanding_refs is_non_volatile_Writesb 
		(takeWhile (Not  is_volatile_Writesb) sbj)"
	    with outstanding_refs_takeWhile [where P'= "Not  is_volatile_Writesb"]
	    have a_in': "a  outstanding_refs is_non_volatile_Writesb sbj"
	      by auto
            from rels_cond [rule_format, OF j_bound [simplified leq] neq_i_j] ts_sim [rule_format, OF j_bound] jth
            have no_unsharing:"release ?take_sbj (dom (𝒮sb)) j  a  Some False"
              by (auto simp add: Let_def)
	    from access_cond
	    show False
	    proof 
	      assume "a  𝒪sb"
	      with ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth] 
		j_owns 
	      show False
		by auto
	    next
	      assume a_shared: "a  dom 𝒮"
              with share_all_until_volatile_write_thread_local [OF ownership_distinct_tssb sharing_consis_tssb j_bound jth j_owns]
              have a_dom: "a  dom  (share ?take_sbj 𝒮sb)"
                by (auto simp add: 𝒮 domIff)
	      from outstanding_non_volatile_writes_unshared [OF j_bound jth]
	      have "non_volatile_writes_unshared 𝒮sb sbj".
	      with non_volatile_writes_unshared_append [of 𝒮sb "(takeWhile (Not  is_volatile_Writesb) sbj)"
		"(dropWhile (Not  is_volatile_Writesb) sbj)"]
	      have unshared_take: "non_volatile_writes_unshared 𝒮sb (takeWhile (Not  is_volatile_Writesb) sbj)" 
	        by clarsimp
              
              from release_not_unshared_no_write_take [OF  unshared_take no_unsharing a_dom] a_in
              show False by auto
	    qed
	  qed
	} 
	thus ?thesis
	  by (fastforce simp add: Let_def)
      qed

      have "flush_all_until_volatile_write tssb msb a = msb a"
      proof -
	from flush_all_until_volatile_write_buffered_val_conv 
	[OF _ i_bound tssb_i a_unflushed]
	show ?thesis
	  by (simp add: sb)
      qed     
      
      hence m_a: "m a = msb a"
	by (simp add: m)

      from cond have cond': "cond (θsb(t  m a))"
	by (simp add: m_a)


      from safe_memop_flush_sb [simplified issb] cond'
      obtain 
	L_subset: "L  A" and
	A_shared_owned: "A  dom 𝒮  𝒪sb" and
	R_owned: "R  𝒪sb" and
        A_R: "A  R = {}" and
	a_unowned_others_ts:
	  "j<length ts. i  j  (a  owned (ts!j)  dom (released (ts!j)))" and
	A_unowned_by_others_ts:
	  "j<length ts. i  j  (A  (owned (ts!j)  dom (released (ts!j))) = {})" and
	a_not_ro: "a  read_only 𝒮"
	by cases (auto simp add: sb)

      from a_unowned_others_ts ts_sim leq
      have a_unowned_others:
        "j<length tssb. i  j  
          (let (_,_,_,sbj,_,𝒪j,_) = tssb!j in 
	    a  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j 
            a  all_shared (takeWhile (Not  is_volatile_Writesb) sbj))" 
  apply (clarsimp simp add: Let_def)
  subgoal for j
	apply (drule_tac x=j in spec)
	apply (auto simp add: dom_release_takeWhile)
	done
  done

      from A_unowned_by_others_ts ts_sim leq
      have A_unowned_by_others:  
	"j<length tssb. ij  (let (_,_,_,sbj,_,𝒪j,_) = tssb!j 
	  in A  (acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j 
                  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)) = {})" 
  apply (clarsimp simp add: Let_def)
  subgoal for j
	apply (drule_tac x=j in spec)
	apply (force simp add: dom_release_takeWhile)
	done
  done

      have a_not_ro': "a  read_only 𝒮sb"
      proof 
	assume a: "a  read_only (𝒮sb)"
	  from local.read_only_unowned_axioms have "read_only_unowned 𝒮sb tssb". 
        from in_read_only_share_all_until_volatile_write' [OF ownership_distinct_tssb sharing_consis_tssb
          ‹read_only_unowned 𝒮sb tssb i_bound tssb_i a_unowned_others, simplified sb, simplified, 
          OF a] 
	have "a  read_only (𝒮)"
	  by (simp add: 𝒮)
	with a_not_ro show False by simp
      qed

      
      {
	fix j 
	fix pj issbj 𝒪j j 𝒟sbj θj sbj
	assume j_bound: "j < length tssb"
	assume tssb_j: "tssb!j=(pj,issbj,θj,sbj,𝒟sbj,𝒪j,j)"
	assume neq_i_j: "ij"
	have "a  unforwarded_non_volatile_reads (dropWhile (Not  is_volatile_Writesb) sbj) {}"
	proof 
	  let ?take_sbj = "takeWhile (Not  is_volatile_Writesb) sbj"
	  let ?drop_sbj = "dropWhile (Not  is_volatile_Writesb) sbj"
	  assume a_in: "a   unforwarded_non_volatile_reads ?drop_sbj {}"

	  from a_unowned_others [rule_format, OF _ neq_i_j] tssb_j j_bound
	  obtain a_unacq_take: "a  acquired True ?take_sbj 𝒪j" and a_not_shared: "a  all_shared ?take_sbj"
	    by auto
(*
	  then obtain
	    a_unowned: "a ∉ 𝒪j" and a_unacq_take': "a ∉ all_acquired ?take_sbj"
	    by (auto simp add: acquired_takeWhile_non_volatile_Writesb)
*)
	  note nvo_j = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound tssb_j]
	  
	  from non_volatile_owned_or_read_only_drop [OF nvo_j]
	  have nvo_drop_j: "non_volatile_owned_or_read_only True (share ?take_sbj 𝒮sb)
	                    (acquired True ?take_sbj 𝒪j) ?drop_sbj" .

	  note consis_j = sharing_consis [OF j_bound tssb_j]
	  with sharing_consistent_append [of 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
	  obtain consis_take_j: "sharing_consistent 𝒮sb 𝒪j ?take_sbj" and
	    consis_drop_j: "sharing_consistent (share ?take_sbj 𝒮sb)
	      (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	    by auto

	  from in_unforwarded_non_volatile_reads_non_volatile_Readsb [OF a_in]
	  have a_in': "a  outstanding_refs is_non_volatile_Readsb ?drop_sbj".

	  note reads_consis_j = valid_reads [OF j_bound tssb_j]
	  from reads_consistent_drop [OF this]
	  have reads_consis_drop_j:
	    "reads_consistent True (acquired True ?take_sbj 𝒪j) (flush ?take_sbj msb) ?drop_sbj".

        
          from read_only_share_all_shared [of a ?take_sbj 𝒮sb] a_not_ro' a_not_shared
          have a_not_ro_j: "a  read_only (share ?take_sbj 𝒮sb)"
            by auto
          



	  from ts_sim [rule_format, OF j_bound] tssb_j j_bound
	  obtain suspendsj "isj" 𝒟j where
	    suspendsj: "suspendsj = ?drop_sbj" and
	    isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	    𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
	    tsj: "ts!j = (hd_prog pj suspendsj, isj, 
	    θj |` (dom θj - read_tmps suspendsj),(),   
	    𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	    by (auto simp: Let_def)

	  from tsj neq_i_j j_bound 
	  have ts'_j: "?ts'!j = (hd_prog pj suspendsj, isj,
	    θj |` (dom θj - read_tmps suspendsj),(), 
	    𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	    by auto

	  from valid_last_prog [OF j_bound tssb_j] have last_prog: "last_prog pj sbj = pj".

	  from j_bound i_bound' leq have j_bound_ts': "j < length ?ts'"
	    by simp

	  from read_only_read_acquired_unforwarded_acquire_witness [OF nvo_drop_j consis_drop_j
	  a_not_ro_j a_unacq_take a_in]
	  have False
	  proof
	    assume "sop a' v ys zs A L R W. 
		?drop_sbj= ys @ Writesb True a' sop v A L R W # zs  a  A  
                a  outstanding_refs is_Writesb ys  a'a"
	    with suspendsj
	    obtain a' sop' v' ys zs' A' L' R' W' where
		split_suspendsj: "suspendsj = ys @ Writesb True a' sop' v' A' L' R' W'# zs'" (is "suspendsj=?suspends") and
		a_A': "a  A'" and
		no_write: "a  outstanding_refs is_Writesb (ys @ [Writesb True a' sop' v' A' L' R' W'])"
	        by(auto simp add: outstanding_refs_append )
		
	    from last_prog
	    have lp: "last_prog pj suspendsj = pj"
	      apply -
	      apply (rule last_prog_same_append [where sb="?take_sbj"])
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	    
	    from sharing_consis [OF j_bound tssb_j]
	    have sharing_consis_j: "sharing_consistent 𝒮sb 𝒪j sbj".
	    then have A'_R': "A'  R' = {}" 
	      by (simp add: sharing_consistent_append [of _ _ ?take_sbj ?drop_sbj, simplified] 
		  suspendsj [symmetric] split_suspendsj sharing_consistent_append)	  

	    from valid_program_history [OF j_bound tssb_j] 
	    have "causal_program_history issbj sbj".
	    then have cph: "causal_program_history issbj ?suspends"
	      apply -
	      apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply (simp add: split_suspendsj)
	      done
	    
	    from valid_reads [OF j_bound tssb_j]
	    have reads_consis_j: "reads_consistent False 𝒪j msb sbj".
	    
	   from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb 
	      j_bound tssb_j this]
	   have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
	    by (simp add: m suspendsj)
	    
	   from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j tssb_i tssb_j]
	   have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
	     by (simp add: suspendsj)
	   from reads_consistent_flush_independent [OF this reads_consis_m_j]
	   have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	        (flush ?drop_sb m) suspendsj".

	   hence reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  
	        (flush ?drop_sb m) (ys@[Writesb True a' sop' v' A' L' R' W'])"
	     by (simp add: split_suspendsj reads_consistent_append)

  	   from valid_write_sops [OF j_bound tssb_j]
	   have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
	     by (simp add: split_suspendsj [symmetric] suspendsj)
	   then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		valid_sops_drop: "sopwrite_sops (ys@[Writesb True a' sop' v' A' L' R' W']). valid_sop sop"
	     apply (simp only: write_sops_append)
	     apply auto
	     done
	    
	   from read_tmps_distinct [OF j_bound tssb_j]
	   have "distinct_read_tmps (?take_sbj@suspendsj)"
	     by (simp add: split_suspendsj [symmetric] suspendsj)
	   then obtain 
	     read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
	     distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
	     apply (simp only: split_suspendsj [symmetric] suspendsj) 
	     apply (simp only: distinct_read_tmps_append)
	     done
	    
	   from valid_history [OF j_bound tssb_j]
	   have h_consis: 
	      "history_consistent θj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	    
	   have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	   proof -
	     from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
	       by simp
	     from last_prog_hd_prog_append' [OF h_consis] this
	     have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
	       by (simp only: split_suspendsj [symmetric] suspendsj) 
	     moreover 
	     have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
	       last_prog (hd_prog pj suspendsj) ?take_sbj"
	       apply (simp only: split_suspendsj [symmetric] suspendsj) 
	       by (rule last_prog_hd_prog_append)
	     ultimately show ?thesis
	       by (simp add: split_suspendsj [symmetric] suspendsj) 
	   qed

	   from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
	      h_consis] last_prog_hd_prog
	   have hist_consis': "history_consistent θj (hd_prog pj suspendsj) suspendsj"
	     by (simp add: split_suspendsj [symmetric] suspendsj)
	   from reads_consistent_drop_volatile_writes_no_volatile_reads  
	   [OF reads_consis_j] 
	   have no_vol_read: "outstanding_refs is_volatile_Readsb 
	      (ys@[Writesb True a' sop' v' A' L' R' W']) = {}"
	     by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )
	    
	   have acq_simp:
	      "acquired True (ys @ [Writesb True a' sop' v' A' L' R' W']) 
              (acquired True ?take_sbj 𝒪j) = 
              acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R'"
	     by (simp add: acquired_append)

	   from flush_store_buffer_append [where sb="ys@[Writesb True a' sop' v' A' L' R' W']" and sb'="zs'", simplified,
	      OF j_bound_ts' isj [simplified split_suspendsj] cph [simplified suspendsj]
	      ts'_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys 
	      hist_consis' [simplified split_suspendsj] valid_sops_drop 
	      distinct_read_tmps_drop [simplified split_suspendsj] 
	      no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="share ?drop_sb 𝒮"]
	    
	   obtain isj' j' where
	      isj': "instrs zs' @ issbj = isj' @ prog_instrs zs'" and
	      steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮)  d* 
		  (?ts'[j:=(last_prog
                              (hd_prog pj (Writesb True a' sop' v' A' L' R' W'# zs')) (ys@[Writesb True a' sop' v' A' L' R' W']),
                             isj',
                             θj |` (dom θj - read_tmps zs'),
                              (), True, acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R',j')],
                    flush (ys@[Writesb True a' sop' v' A' L' R' W']) (flush ?drop_sb m),
                    share (ys@[Writesb True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
		   (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
             by (auto simp add: acquired_append outstanding_refs_append)

	   from i_bound' have i_bound_ys: "i < length ?ts_ys"
	     by auto
	    
	   from i_bound' neq_i_j 
	   have ts_ys_i: "?ts_ys!i = (psb, issb, θsb,(), 
	      𝒟sb, acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb)"
	     by simp
	   note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
	    
	   from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	   have safe: "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	      
	   from flush_unchanged_addresses [OF no_write] 
	   have "flush (ys @ [Writesb True a' sop' v' A' L' R' W']) m a = m a".
	    
	   with safe_delayedE [OF safe i_bound_ys ts_ys_i, simplified issb] cond'
	   have a_unowned: 
	      
	      "j < length ?ts_ys. ij  (let (𝒪j) = map owned ?ts_ys!j in a  𝒪j)"
	     apply cases
	     apply (auto simp add: Let_def issb sb)
	     done
	   from a_A' a_unowned [rule_format, of j] neq_i_j j_bound leq A'_R'
	    show False
	      by (auto simp add: Let_def)
	  next
	    assume "A L R W ys zs. ?drop_sbj = ys @ Ghostsb A L R W# zs  a  A  a  outstanding_refs is_Writesb ys"
	    with  suspendsj 
	    obtain ys zs' A' L' R' W' where
	      split_suspendsj: "suspendsj = ys @ Ghostsb A' L' R' W'# zs'" (is "suspendsj=?suspends") and
	      a_A': "a  A'" and
	      no_write: "a  outstanding_refs is_Writesb (ys @ [Ghostsb A' L' R' W'])"
	      by (auto simp add: outstanding_refs_append)

	    from last_prog
	    have lp: "last_prog pj suspendsj = pj"
	      apply -
	      apply (rule last_prog_same_append [where sb="?take_sbj"])
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	    from sharing_consis [OF j_bound tssb_j]
	    have sharing_consis_j: "sharing_consistent 𝒮sb 𝒪j sbj".
	    then have A'_R': "A'  R' = {}" 
	      by (simp add: sharing_consistent_append [of _ _ ?take_sbj ?drop_sbj, simplified] 
		  suspendsj [symmetric] split_suspendsj sharing_consistent_append)	  


	    from valid_program_history [OF j_bound tssb_j] 
	    have "causal_program_history issbj sbj".
	    then have cph: "causal_program_history issbj ?suspends"
	      apply -
	      apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply (simp add: split_suspendsj)
	      done
	    
	    from valid_reads [OF j_bound tssb_j]
	    have reads_consis_j: "reads_consistent False 𝒪j msb sbj".
	    
	    from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb 
	      j_bound tssb_j this]
	    have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
	      by (simp add: m suspendsj)
	    
	    from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j tssb_i tssb_j]
	    have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
	      by (simp add: suspendsj)
	    from reads_consistent_flush_independent [OF this reads_consis_m_j]
	    have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	      (flush ?drop_sb m) suspendsj".

	    hence reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  
	      (flush ?drop_sb m) (ys@[Ghostsb A' L' R' W'])"
	      by (simp add: split_suspendsj reads_consistent_append)

	    from valid_write_sops [OF j_bound tssb_j]
	    have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
	      valid_sops_drop: "sopwrite_sops (ys@[Ghostsb A' L' R' W']). valid_sop sop"
	      apply (simp only: write_sops_append)
	      apply auto
	      done
	    
	    from read_tmps_distinct [OF j_bound tssb_j]
	    have "distinct_read_tmps (?take_sbj@suspendsj)"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain 
	      read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
	      distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
	      apply (simp only: split_suspendsj [symmetric] suspendsj) 
	      apply (simp only: distinct_read_tmps_append)
	      done
	    
	    from valid_history [OF j_bound tssb_j]
	    have h_consis: 
	      "history_consistent θj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	    
	    have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	    proof -
	      from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		by simp
	      from last_prog_hd_prog_append' [OF h_consis] this
	      have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		by (simp only: split_suspendsj [symmetric] suspendsj) 
	      moreover 
	      have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		last_prog (hd_prog pj suspendsj) ?take_sbj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		by (rule last_prog_hd_prog_append)
	      ultimately show ?thesis
		by (simp add: split_suspendsj [symmetric] suspendsj) 
	    qed

	    from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
	      h_consis] last_prog_hd_prog
	    have hist_consis': "history_consistent θj (hd_prog pj suspendsj) suspendsj"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    from reads_consistent_drop_volatile_writes_no_volatile_reads  
	    [OF reads_consis_j] 
	    have no_vol_read: "outstanding_refs is_volatile_Readsb 
	      (ys@[Ghostsb A' L' R' W']) = {}"
	      by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )
	    
	    have acq_simp:
	      "acquired True (ys @ [Ghostsb A' L' R' W']) 
              (acquired True ?take_sbj 𝒪j) = 
              acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R'"
	      by (simp add: acquired_append)

	    from flush_store_buffer_append [where sb="ys@[Ghostsb A' L' R' W']" and sb'="zs'", simplified,
	      OF j_bound_ts' isj [simplified split_suspendsj] cph [simplified suspendsj]
	      ts'_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys 
	      hist_consis' [simplified split_suspendsj] valid_sops_drop 
	      distinct_read_tmps_drop [simplified split_suspendsj] 
	      no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="share ?drop_sb 𝒮"]
	    
	    obtain isj' j' where
	      isj': "instrs zs' @ issbj = isj' @ prog_instrs zs'" and
	      steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮)  d* 
		  (?ts'[j:=(last_prog
                              (hd_prog pj (Ghostsb A' L' R' W'# zs')) (ys@[Ghostsb A' L' R' W']),
                             isj',
                             θj |` (dom θj - read_tmps zs'),
                              (), 
	                     𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R',j')],
                    flush (ys@[Ghostsb A' L' R' W']) (flush ?drop_sb m),
                    share (ys@[Ghostsb A' L' R' W']) (share ?drop_sb 𝒮))"
		   (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
              by (auto simp add: acquired_append outstanding_refs_append)

	    from i_bound' have i_bound_ys: "i < length ?ts_ys"
	      by auto
	    
	    from i_bound' neq_i_j 
	    have ts_ys_i: "?ts_ys!i = (psb, issb, θsb,(), 
	      𝒟sb, acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb)"
	      by simp
	    note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
	    
	    from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	    have safe: "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	      
	    from flush_unchanged_addresses [OF no_write] 
	    have "flush (ys @ [Ghostsb A' L' R' W']) m a = m a".
	    
	    with safe_delayedE [OF safe i_bound_ys ts_ys_i, simplified issb] cond'
	    have a_unowned: 
	      
	      "j < length ?ts_ys. ij  (let (𝒪j) = map owned ?ts_ys!j in a  𝒪j)"
	      apply cases
	      apply (auto simp add: Let_def issb sb)
	      done
	    from a_A' a_unowned [rule_format, of j] neq_i_j j_bound leq A'_R'

	    show False
	      by (auto simp add: Let_def)
	  qed
	  then show False
	    by simp
	qed
      }
      note a_notin_unforwarded_non_volatile_reads_drop = this

      (* FIXME: split in to theorems, one for A ∩ 𝒪j and  one for
	 A ∩ outstanding_refs…    *) 
      have A_unused_by_others:
	  "j<length (map 𝒪_sb tssb). i  j 
             (let (𝒪j, sbj) = map 𝒪_sb tssb! j
             in A   (𝒪j  outstanding_refs is_volatile_Writesb sbj) = {})"
      proof -
	{
	  fix j 𝒪j sbj
	  assume j_bound: "j < length (map owned tssb)"
	  assume neq_i_j: "ij"
	  assume tssb_j: "(map 𝒪_sb tssb)!j = (𝒪j,sbj)"
	  assume conflict: "A  (𝒪j  outstanding_refs is_volatile_Writesb sbj)  {}"
	  have False
	  proof -
	    from j_bound leq
	    have j_bound': "j < length (map owned ts)"
	      by auto
	    from j_bound have j_bound'': "j < length tssb"
	      by auto
	    from j_bound' have j_bound''': "j < length ts"
	      by simp
	    
	    from conflict obtain a' where
	      a_in: "a'  A" and
              conflict: "a'  𝒪j  a'  outstanding_refs is_volatile_Writesb sbj"
	      by auto
            from A_unowned_by_others [rule_format, OF _ neq_i_j] j_bound  tssb_j
            have A_unshared_j: "A  all_shared (takeWhile (Not  is_volatile_Writesb) sbj) = {}"
              by (auto simp add: Let_def)
	    from conflict
	    show ?thesis
	    proof

 	      assume "a'  𝒪j"

              from all_shared_acquired_in [OF this] A_unshared_j a_in
	      have conflict: "a'  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j"
	        by (auto)
              with A_unowned_by_others [rule_format, OF _ neq_i_j] j_bound  tssb_j a_in
              show False by auto
	    next
	      assume a_in_j: "a'  outstanding_refs is_volatile_Writesb sbj"

	      let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	      let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"

	      from ts_sim [rule_format, OF  j_bound''] tssb_j j_bound''
	      obtain pj suspendsj "issbj" 𝒟sbj 𝒟j j θsbj "isj" where
		  tssb_j: "tssb ! j = (pj,issbj, θsbj, sbj,𝒟sbj,𝒪j,j)" and
		  suspendsj: "suspendsj = ?drop_sbj" and
		  𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
		  isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
		  tsj: "ts!j = (hd_prog pj suspendsj, isj,
		       θsbj |` (dom θsbj - read_tmps suspendsj),(), 𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
		apply (cases "tssb!j")
		apply (force simp add: Let_def)
		done
	      


	      have "a'  outstanding_refs is_volatile_Writesb suspendsj"
	      proof -	
		from a_in_j 
		have "a'  outstanding_refs is_volatile_Writesb (?take_sbj @ ?drop_sbj)"
		  by simp
		thus ?thesis
		  apply (simp only: outstanding_refs_append suspendsj)
		  apply (auto simp add: outstanding_refs_conv dest: set_takeWhileD)
		  done
	      qed
		 
	      from split_volatile_Writesb_in_outstanding_refs [OF this]
	      obtain sop' v' ys zs A' L' R' W' where
		split_suspendsj: "suspendsj = ys @ Writesb True a' sop' v' A' L' R' W'# zs" (is "suspendsj = ?suspends")
		by blast
	      


	      from valid_program_history [OF j_bound'' tssb_j] 
	      have "causal_program_history issbj sbj".
	      then have cph: "causal_program_history issbj ?suspends"
		apply -
		apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply (simp add: split_suspendsj)
		done

	      from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
	      then
	      have lp: "last_prog pj ?suspends = pj"
		apply -
		apply (rule last_prog_same_append [where sb="?take_sbj"])
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done

	      from valid_reads [OF j_bound'' tssb_j]
	      have reads_consis: "reads_consistent False 𝒪j msb sbj".
	      from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb 
		j_bound''
		tssb_j this]
	      have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		by (simp add: m suspendsj)

	      from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' tssb_j]
	      have nvo_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j sbj".
	      with non_volatile_owned_or_read_only_append [of False 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
	      have nvo_take_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j ?take_sbj"
		by auto

	      from a_unowned_others [rule_format, OF _ neq_i_j] tssb_j j_bound
	      have a_not_acq: "a  acquired True ?take_sbj 𝒪j"
		by auto

	      from a_notin_unforwarded_non_volatile_reads_drop[OF j_bound'' tssb_j neq_i_j]
	      have a_notin_unforwarded_reads: "a  unforwarded_non_volatile_reads suspendsj {}"
		by (simp add: suspendsj)
		
	      let ?ma="(m(a := f (θsb(tm a))))"

	      from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads [where W="{}" 
		and m'="?ma",simplified, OF _ subset_refl reads_consis_m_j] 
		a_notin_unforwarded_reads
	      have reads_consis_ma_j: 
		"reads_consistent True (acquired True ?take_sbj 𝒪j) ?ma suspendsj"
		by auto

	      from reads_consis_ma_j 
	      have reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j) ?ma (ys)"
		by (simp add: split_suspendsj reads_consistent_append)

	      from direct_memop_step.RMWWrite [where cond=cond and θ=θsb and m=m, OF cond' ]
	      have "(RMW a t (D, f) cond ret A L R W# issb',  θsb, (), m,𝒟, 𝒪sb, sb, 𝒮)  
                    (issb', θsb(t  ret (m a) (f (θsb(t  m a)))), (), ?ma, False, 𝒪sb  A - R, Map.empty,𝒮W RA L)".
	      from direct_computation.concurrent_step.Memop [OF i_bound' ts_i  this] 
	      have step_a: "(ts, m, 𝒮) d 
                    (ts[i := (psb, issb', θsb(t  ret (m a) (f (θsb(t  m a)))), (), False, 𝒪sb  A - R,Map.empty)], 
                      ?ma,𝒮W RA L)"
		(is " _ d (?ts_a, _, ?shared_a)").

	      from tsj neq_i_j j_bound 

	      have ts_a_j: "?ts_a!j = (hd_prog pj suspendsj, isj,
		θsbj |` (dom θsbj - read_tmps suspendsj),(), 𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom (𝒮sb)) j)"
		by auto


	      from valid_write_sops [OF j_bound'' tssb_j]
	      have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		valid_sops_drop: "sopwrite_sops (ys). valid_sop sop"
		apply (simp only: write_sops_append)
		apply auto
		done

	      from read_tmps_distinct [OF j_bound'' tssb_j]
	      have "distinct_read_tmps (?take_sbj@suspendsj)"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain 
		read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
	      distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		apply (simp only: distinct_read_tmps_append)
		done
	    
	      from valid_history [OF j_bound'' tssb_j]
	      have h_consis: 
		"history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done
	    
	      have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	      proof -
		from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		  by simp
	      from last_prog_hd_prog_append' [OF h_consis] this
	      have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		by (simp only: split_suspendsj [symmetric] suspendsj) 
	      moreover 
	      have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		last_prog (hd_prog pj suspendsj) ?take_sbj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		by (rule last_prog_hd_prog_append)
	      ultimately show ?thesis
		by (simp add: split_suspendsj [symmetric] suspendsj) 
	    qed

	    from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
	      h_consis] last_prog_hd_prog
	    have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    from reads_consistent_drop_volatile_writes_no_volatile_reads  
	    [OF reads_consis] 
	    have no_vol_read: "outstanding_refs is_volatile_Readsb (ys) = {}"
	      by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )
	    from j_bound' have j_bound_ts_a: "j < length ?ts_a" by auto

	    
	    from flush_store_buffer_append [where sb="ys" and sb'="Writesb True a' sop' v' A' L' R' W'#zs", simplified,
	    OF j_bound_ts_a isj [simplified split_suspendsj] cph [simplified suspendsj]
ts_a_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys
 	      hist_consis' [simplified split_suspendsj] valid_sops_drop 
	      distinct_read_tmps_drop [simplified split_suspendsj] 
              no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="?shared_a"]

	    obtain isj' j' where
	      isj': "Write True a' sop' A' L' R' W'# instrs zs @ issbj = isj' @ prog_instrs zs" and
	      steps_ys: "(?ts_a, ?ma, ?shared_a)  d* 
		(?ts_a[j:=(last_prog
                            (hd_prog pj zs) ys,
              isj',
                           θsbj |` (dom θsbj - read_tmps zs),
                            (), 𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j')],
                  flush ys (?ma),    share ys (?shared_a))"
		 (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
              by (auto simp add: acquired_append)

	    from cph
	    have "causal_program_history issbj ((ys @ [Writesb True a' sop' v' A' L' R' W']) @ zs)"
	      by simp
	    from causal_program_history_suffix [OF this]
	    have cph': "causal_program_history issbj zs".	      
	    interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

	    from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
	    obtain isj''
	      where isj': "isj' = Write True a' sop' A' L' R' W'#isj''" and
	      isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
	      by clarsimp
	    
	    from i_bound' have i_bound_ys: "i < length ?ts_ys"
	      by auto

	    from i_bound' neq_i_j 
	    have ts_ys_i: "?ts_ys!i = (psb, issb', 
	      θsb(t  ret (m a) (f (θsb(t  m a)))),(), False, 𝒪sb  A - R,Map.empty)"
	      by simp

	    from j_bound_ts_a have j_bound_ys: "j < length ?ts_ys"
	      by auto
	    then have ts_ys_j: "?ts_ys!j = (last_prog (hd_prog pj zs) ys, Write True a' sop' A' L' R' W'#isj'', θsbj |` (dom θsbj - read_tmps zs), (), 𝒟j  outstanding_refs is_volatile_Writesb ys  {}, 
	      acquired True ys (acquired True ?take_sbj 𝒪j),j')"
	      by (clarsimp simp add: isj')
	    note conflict_computation = r_rtranclp_rtranclp [OF step_a steps_ys]
	    
	    from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	    have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".


	      from safe_delayedE [OF this j_bound_ys ts_ys_j]
	      have a_unowned: 
		"i < length ts. ji  (let (𝒪i) = map owned ?ts_ys!i in a'  𝒪i)"
		apply cases
		apply (auto simp add: Let_def)
		done
	      from a_in a_unowned [rule_format, of i] neq_i_j i_bound' A_R 
	      show False
		by (auto simp add: Let_def)
	    qed
	  qed
	}
	thus ?thesis
	  by (auto simp add: Let_def)
      qed

      have A_unacquired_by_others:
	  "j<length (map 𝒪_sb tssb). i  j 
             (let (𝒪j, sbj) = map 𝒪_sb tssb! j
             in A  all_acquired sbj = {})"
      proof -
	{
	  fix j 𝒪j sbj
	  assume j_bound: "j < length (map owned tssb)"
	  assume neq_i_j: "ij"
	  assume tssb_j: "(map 𝒪_sb tssb)!j = (𝒪j,sbj)"
	  assume conflict: "A  all_acquired sbj  {}"
	  have False
	  proof -
	    from j_bound leq
	    have j_bound': "j < length (map owned ts)"
	      by auto
	    from j_bound have j_bound'': "j < length tssb"
	      by auto
	    from j_bound' have j_bound''': "j < length ts"
	      by simp
	    
	    from conflict obtain a' where
	      a'_in: "a'  A" and
              a'_in_j: "a'  all_acquired sbj"
	      by auto

	    let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	    let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"

	    from ts_sim [rule_format, OF  j_bound''] tssb_j j_bound''
	    obtain pj suspendsj "issbj" θsbj 𝒟sbj j 𝒟j "isj" where
	      tssb_j: "tssb ! j = (pj,issbj,θsbj, sbj,𝒟sbj,𝒪j,j)" and
	      suspendsj: "suspendsj = ?drop_sbj" and
	      isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	      𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
	      tsj: "ts!j = (hd_prog pj suspendsj, isj, 
	             θsbj |` (dom θsbj - read_tmps suspendsj),(),   
	             𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	      apply (cases "tssb!j")
	      apply (force simp add: Let_def)
	      done
	      

	    from a'_in_j all_acquired_append [of ?take_sbj ?drop_sbj]
	    have "a'  all_acquired ?take_sbj  a'  all_acquired suspendsj"
	      by (auto simp add: suspendsj)
	    thus False
	    proof 
	      assume "a'  all_acquired ?take_sbj"
	      with A_unowned_by_others [rule_format, OF _ neq_i_j] tssb_j j_bound a'_in
	      show False
		by (auto dest: all_acquired_unshared_acquired)
	    next
	      assume conflict_drop: "a'  all_acquired suspendsj"
	      
	      from split_all_acquired_in [OF conflict_drop]
	      show ?thesis
	      proof
		assume "sop a'' v ys zs A L R W. 
                  suspendsj = ys @ Writesb True a'' sop v A L R W# zs  a'  A"
		then 
		obtain a'' sop' v' ys zs A' L' R' W' where
		  split_suspendsj: "suspendsj = ys @ Writesb True a'' sop' v' A' L' R' W'# zs" (is "suspendsj = ?suspends") and
		  a'_A': "a'  A'"
		  by blast
	    

		from valid_program_history [OF j_bound'' tssb_j] 
		have "causal_program_history issbj sbj".
		then have cph: "causal_program_history issbj ?suspends"
		  apply -
		  apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		  apply (simp only: split_suspendsj [symmetric] suspendsj)
		  apply (simp add: split_suspendsj)
		  done
		
		from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
		then
		have lp: "last_prog pj ?suspends = pj"
		  apply -
		  apply (rule last_prog_same_append [where sb="?take_sbj"])
		  apply (simp only: split_suspendsj [symmetric] suspendsj)
		  apply simp
		  done
		
		from valid_reads [OF j_bound'' tssb_j]
		have reads_consis: "reads_consistent False 𝒪j msb sbj".
		from reads_consistent_flush_all_until_volatile_write [OF 
		  ‹valid_ownership_and_sharing 𝒮sb tssb  j_bound''
		  tssb_j this]
		have reads_consis_m_j: 
		  "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		  by (simp add: m suspendsj)
		
		from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' tssb_j]
		have nvo_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j sbj".
		with non_volatile_owned_or_read_only_append [of False 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
		have nvo_take_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j ?take_sbj"
		  by auto
		
		from a_unowned_others [rule_format, OF _ neq_i_j] tssb_j j_bound
		have a_not_acq: "a  acquired True ?take_sbj 𝒪j"
		  by auto
	      
		from a_notin_unforwarded_non_volatile_reads_drop[OF j_bound'' tssb_j neq_i_j]
		have a_notin_unforwarded_reads: "a  unforwarded_non_volatile_reads suspendsj {}"
		  by (simp add: suspendsj)    

		let ?ma="(m(a := f (θsb(tm a))))"

		from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads [where W="{}" 
		  and m'="?ma",simplified, OF _ subset_refl reads_consis_m_j] 
		  a_notin_unforwarded_reads
		have reads_consis_ma_j: 
		  "reads_consistent True (acquired True ?take_sbj 𝒪j) ?ma suspendsj"
		  by auto


		from reads_consis_ma_j 
		have reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j) ?ma (ys)"
		  by (simp add: split_suspendsj reads_consistent_append)

	    
		from direct_memop_step.RMWWrite [where cond=cond and θ=θsb and m=m, OF cond']
		have "(RMW a t (D, f) cond ret A L R W# issb',
		        θsb, (), m, 𝒟, 𝒪sb, sb, 𝒮)  
                    (issb', 
		       θsb(t  ret (m a) (f (θsb(t  m a)))), (), ?ma, False, 𝒪sb  A - R,Map.empty, 𝒮W RA L)".
		from direct_computation.concurrent_step.Memop [OF i_bound' ts_i [simplified sb, simplified] this]
		have step_a: "(ts, m, 𝒮) d 
                    (ts[i := (psb, issb', θsb(t  ret (m a) (f (θsb(t  m a)))), (), False, 𝒪sb  A - R,Map.empty)], 
                       ?ma,𝒮W RA L)"
		  (is " _ d (?ts_a, _, ?shared_a)").
	      

		from tsj neq_i_j j_bound 

		have ts_a_j: "?ts_a!j = (hd_prog pj suspendsj, isj,
		  θsbj |` (dom θsbj - read_tmps suspendsj),(), 
		  𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
		  by auto
	    
		
		from valid_write_sops [OF j_bound'' tssb_j]
		have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		  by (simp add: split_suspendsj [symmetric] suspendsj)
		then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		  valid_sops_drop: "sopwrite_sops (ys). valid_sop sop"
		  apply (simp only: write_sops_append)
		  apply auto
		  done
	    
		from read_tmps_distinct [OF j_bound'' tssb_j]
		have "distinct_read_tmps (?take_sbj@suspendsj)"
		  by (simp add: split_suspendsj [symmetric] suspendsj)
		then obtain 
		  read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
		  distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		  apply (simp only: split_suspendsj [symmetric] suspendsj) 
		  apply (simp only: distinct_read_tmps_append)
		  done
	    
		from valid_history [OF j_bound'' tssb_j]
		have h_consis: 
		  "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		  apply (simp only: split_suspendsj [symmetric] suspendsj)
		  apply simp
		  done
	    
		have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
		proof -
		  from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		    by simp
		  from last_prog_hd_prog_append' [OF h_consis] this
		  have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		    by (simp only: split_suspendsj [symmetric] suspendsj) 
		  moreover 
		  have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		    last_prog (hd_prog pj suspendsj) ?take_sbj"
		    apply (simp only: split_suspendsj [symmetric] suspendsj) 
		    by (rule last_prog_hd_prog_append)
		  ultimately show ?thesis
		    by (simp add: split_suspendsj [symmetric] suspendsj) 
		qed
	    
		from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
		  h_consis] last_prog_hd_prog
		have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
		  by (simp add: split_suspendsj [symmetric] suspendsj)
		from reads_consistent_drop_volatile_writes_no_volatile_reads  
		[OF reads_consis] 
		have no_vol_read: "outstanding_refs is_volatile_Readsb (ys) = {}"
		  by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		    split_suspendsj )
		from j_bound' have j_bound_ts_a: "j < length ?ts_a" by auto
	    
		from flush_store_buffer_append [where sb="ys" and sb'="Writesb True a'' sop' v' A' L' R' W'#zs", simplified,
		  OF j_bound_ts_a isj [simplified split_suspendsj] cph [simplified suspendsj]
		  ts_a_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys
 		  hist_consis' [simplified split_suspendsj] valid_sops_drop 
		  distinct_read_tmps_drop [simplified split_suspendsj] 
		  no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
		  𝒮="?shared_a"]
	    
		obtain isj' j' where
		  isj': "Write True a'' sop' A' L' R' W'# instrs zs @ issbj = isj' @ prog_instrs zs" and
		  steps_ys: "(?ts_a, ?ma, ?shared_a)  d* 
		  (?ts_a[j:=(last_prog
                            (hd_prog pj zs) ys,
		             isj',
                             θsbj |` (dom θsbj - read_tmps zs),
                             (),
		             𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j')],
                  flush ys (?ma),
                  share ys (?shared_a))"
		 (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
		  by (auto simp add: acquired_append)

		from cph
		have "causal_program_history issbj ((ys @ [Writesb True a'' sop' v' A' L' R' W']) @ zs)"
		  by simp
		from causal_program_history_suffix [OF this]
		have cph': "causal_program_history issbj zs".	      
		interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

		from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
		obtain isj''
		  where isj': "isj' = Write True a'' sop' A' L' R' W'#isj''" and
		  isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
		  by clarsimp
		
		from i_bound' have i_bound_ys: "i < length ?ts_ys"
		  by auto
		
		from i_bound' neq_i_j 
		have ts_ys_i: "?ts_ys!i = (psb, issb',
		  θsb(t  ret (m a) (f (θsb(t  m a)))),(), False, 𝒪sb  A - R,Map.empty)"
		  by simp
		
		from j_bound_ts_a have j_bound_ys: "j < length ?ts_ys"
		  by auto
		then have ts_ys_j: "?ts_ys!j = (last_prog (hd_prog pj zs) ys, Write True a'' sop' A' L' R' W'#isj'',
		  θsbj |` (dom θsbj - read_tmps zs), (), 
		  𝒟j  outstanding_refs is_volatile_Writesb ys  {}, 
		  acquired True ys (acquired True ?take_sbj 𝒪j),j')"
		  by (clarsimp simp add: isj')
		note conflict_computation = r_rtranclp_rtranclp [OF step_a steps_ys]
	    
		from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
		have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
		
		
		from safe_delayedE [OF this j_bound_ys ts_ys_j]
		have A'_unowned: 
		  "i < length ?ts_ys. ji  (let (𝒪i) = map owned ?ts_ys!i in A'   𝒪i = {})"
		  apply cases
		  apply (fastforce simp add: Let_def issb)+
		  done
		from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R
		show False
		  by (auto simp add: Let_def)
	      next
		assume "A L R W ys zs. suspendsj = ys @ Ghostsb A L R W# zs  a'  A"
		then 
		obtain ys zs A' L' R' W' where
		  split_suspendsj: "suspendsj = ys @ Ghostsb A' L' R' W'# zs" (is "suspendsj = ?suspends") and
		  a'_A': "a'  A'"
		  by blast
	    

		from valid_program_history [OF j_bound'' tssb_j] 
		have "causal_program_history issbj sbj".
		then have cph: "causal_program_history issbj ?suspends"
		  apply -
		  apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		  apply (simp only: split_suspendsj [symmetric] suspendsj)
		  apply (simp add: split_suspendsj)
		  done
		
		from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
		then
		have lp: "last_prog pj ?suspends = pj"
		  apply -
		  apply (rule last_prog_same_append [where sb="?take_sbj"])
		  apply (simp only: split_suspendsj [symmetric] suspendsj)
		  apply simp
		  done
		
		
		from valid_reads [OF j_bound'' tssb_j]
		have reads_consis: "reads_consistent False 𝒪j msb sbj".
		from reads_consistent_flush_all_until_volatile_write [OF 
		  ‹valid_ownership_and_sharing 𝒮sb tssb  j_bound''
		  tssb_j this]
		have reads_consis_m_j: 
		  "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		  by (simp add: m suspendsj)
		
		from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' tssb_j]
		have nvo_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j sbj".
		with non_volatile_owned_or_read_only_append [of False 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
		have nvo_take_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j ?take_sbj"
		  by auto
		
		from a_unowned_others [rule_format, OF _ neq_i_j] tssb_j j_bound
		have a_not_acq: "a  acquired True ?take_sbj 𝒪j"
		  by auto
	      
		from a_notin_unforwarded_non_volatile_reads_drop[OF j_bound'' tssb_j neq_i_j]
		have a_notin_unforwarded_reads: "a  unforwarded_non_volatile_reads suspendsj {}"
		  by (simp add: suspendsj)    

		let ?ma="(m(a := f (θsb(tm a))))"

		from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads [where W="{}" 
		  and m'="?ma",simplified, OF _ subset_refl reads_consis_m_j] 
		  a_notin_unforwarded_reads
		have reads_consis_ma_j: 
		  "reads_consistent True (acquired True ?take_sbj 𝒪j) ?ma suspendsj"
		  by auto


		from reads_consis_ma_j 
		have reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j) ?ma (ys)"
		  by (simp add: split_suspendsj reads_consistent_append)
	    
		from direct_memop_step.RMWWrite [where cond=cond and θ=θsb and m=m, OF cond']
		have "(RMW a t (D, f) cond ret A L R W# issb', 
		        θsb, (), m, 𝒟,𝒪sb,  sb, 𝒮)  
                    (issb', 
                        θsb(t  ret (m a) (f (θsb(t  m a)))), (), ?ma, False, 𝒪sb  A - R,Map.empty,𝒮W RA L)".
		from direct_computation.concurrent_step.Memop [OF i_bound' ts_i [simplified sb, simplified] this]
		have step_a: "(ts, m, 𝒮) d 
                    (ts[i := (psb, issb', θsb(t  ret (m a) (f (θsb(t  m a)))), (), False, 𝒪sb  A - R,Map.empty)], 
                      ?ma,𝒮W RA L)"
		  (is " _ d (?ts_a, _, ?shared_a)").
	      

		from tsj neq_i_j j_bound 

		have ts_a_j: "?ts_a!j = (hd_prog pj suspendsj, isj,
		  θsbj |` (dom θsbj - read_tmps suspendsj),(), 𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
		  by auto
	    
		
		from valid_write_sops [OF j_bound'' tssb_j]
		have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		  by (simp add: split_suspendsj [symmetric] suspendsj)
		then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		  valid_sops_drop: "sopwrite_sops (ys). valid_sop sop"
		  apply (simp only: write_sops_append)
		  apply auto
		  done
	    
		from read_tmps_distinct [OF j_bound'' tssb_j]
		have "distinct_read_tmps (?take_sbj@suspendsj)"
		  by (simp add: split_suspendsj [symmetric] suspendsj)
		then obtain 
		  read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
		  distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		  apply (simp only: split_suspendsj [symmetric] suspendsj) 
		  apply (simp only: distinct_read_tmps_append)
		  done
	    
		from valid_history [OF j_bound'' tssb_j]
		have h_consis: 
		  "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		  apply (simp only: split_suspendsj [symmetric] suspendsj)
		  apply simp
		  done
	    
		have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
		proof -
		  from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		    by simp
		  from last_prog_hd_prog_append' [OF h_consis] this
		  have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		    by (simp only: split_suspendsj [symmetric] suspendsj) 
		  moreover 
		  have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		    last_prog (hd_prog pj suspendsj) ?take_sbj"
		    apply (simp only: split_suspendsj [symmetric] suspendsj) 
		    by (rule last_prog_hd_prog_append)
		  ultimately show ?thesis
		    by (simp add: split_suspendsj [symmetric] suspendsj) 
		qed
	    
		from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
		  h_consis] last_prog_hd_prog
		have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
		  by (simp add: split_suspendsj [symmetric] suspendsj)
		from reads_consistent_drop_volatile_writes_no_volatile_reads  
		[OF reads_consis] 
		have no_vol_read: "outstanding_refs is_volatile_Readsb (ys) = {}"
		  by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		    split_suspendsj )
		from j_bound' have j_bound_ts_a: "j < length ?ts_a" by auto
	    
		from flush_store_buffer_append [where sb="ys" and sb'="Ghostsb A' L' R' W'#zs", simplified,
		  OF j_bound_ts_a isj [simplified split_suspendsj] cph [simplified suspendsj]
		  ts_a_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys
 		  hist_consis' [simplified split_suspendsj] valid_sops_drop 
		  distinct_read_tmps_drop [simplified split_suspendsj] 
		  no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
		  𝒮="?shared_a"]
	    
		obtain isj' j' where
		  isj': "Ghost A' L' R' W'# instrs zs @ issbj = isj' @ prog_instrs zs" and
		  steps_ys: "(?ts_a, ?ma, ?shared_a)  d* 
		  (?ts_a[j:=(last_prog
                            (hd_prog pj zs) ys,
		             isj',
                             θsbj |` (dom θsbj - read_tmps zs),
                             (),
		             𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j')],
                  flush ys (?ma),
                  share ys (?shared_a))"
		 (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
		 by (auto simp add: acquired_append)

	       from cph
	       have "causal_program_history issbj ((ys @ [Ghostsb A' L' R' W']) @ zs)"
		 by simp
	       from causal_program_history_suffix [OF this]
	       have cph': "causal_program_history issbj zs".	      
	       interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

	       from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
	       obtain isj''
		 where isj': "isj' = Ghost A' L' R' W'#isj''" and
		 isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
		 by clarsimp
	       
	       from i_bound' have i_bound_ys: "i < length ?ts_ys"
		 by auto
	       
	       from i_bound' neq_i_j 
	       have ts_ys_i: "?ts_ys!i = (psb, issb',
		 θsb(t  ret (m a) (f (θsb(t  m a)))),(), False, 𝒪sb  A - R,Map.empty)"
		 by simp
	    
	       from j_bound_ts_a have j_bound_ys: "j < length ?ts_ys"
		 by auto
	       then have ts_ys_j: "?ts_ys!j = (last_prog (hd_prog pj zs) ys, Ghost A' L' R' W'#isj'',
		 θsbj |` (dom θsbj - read_tmps zs), (), 
		 𝒟j  outstanding_refs is_volatile_Writesb ys  {}, 
		 acquired True ys (acquired True ?take_sbj 𝒪j),j')"
		 by (clarsimp simp add: isj')
	       note conflict_computation = r_rtranclp_rtranclp [OF step_a steps_ys]
	    
	       from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	       have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	       

	       from safe_delayedE [OF this j_bound_ys ts_ys_j]
	       have A'_unowned: 
		 "i < length ?ts_ys. ji  (let (𝒪i) = map owned ?ts_ys!i in A'   𝒪i = {})"
		 apply cases
		 apply (fastforce simp add: Let_def issb)+
		 done
	       from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R
	       show False
		 by (auto simp add: Let_def)
	     qed
	   qed
	 qed
	}
	thus ?thesis
	  by (auto simp add: Let_def)
      qed



      {
	fix j 
	fix pj issbj 𝒪j j 𝒟sbj θj sbj
	assume j_bound: "j < length tssb"
	assume tssb_j: "tssb!j=(pj,issbj,θj,sbj,𝒟sbj,𝒪j,j)"
	assume neq_i_j: "ij"
	have "A  read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j) 
	           (dropWhile (Not  is_volatile_Writesb) sbj) = {}"
	proof -
	  {
	    let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	    let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"
	    
	    assume conflict: "A  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj  {}"
	    have False
	    proof -
	      from conflict obtain a' where
		a'_in: "a'  A" and
		a'_in_j: "a'  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
		by auto
	      
	      
	      from ts_sim [rule_format, OF  j_bound] tssb_j j_bound
	      obtain pj suspendsj "issbj" 𝒟sbj 𝒟j θsbj "isj" where
		tssb_j: "tssb ! j = (pj,issbj, θsbj, sbj,𝒟sbj,𝒪j,j)" and
		suspendsj: "suspendsj = ?drop_sbj" and
		isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
		𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
		tsj: "ts!j = (hd_prog pj suspendsj, isj,
	        θsbj |` (dom θsbj - read_tmps suspendsj),(), 𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
		apply (cases "tssb!j")
		apply (clarsimp simp add: Let_def)
		done
	      from split_in_read_only_reads [OF a'_in_j [simplified suspendsj [symmetric]]]
	      obtain t' v' ys zs where
		split_suspendsj: "suspendsj = ys @ Readsb False a' t' v'# zs" (is "suspendsj = ?suspends") and
		a'_unacq: "a'  acquired True ys (acquired True ?take_sbj 𝒪j)"
		by blast

	      from valid_program_history [OF j_bound tssb_j] 
	      have "causal_program_history issbj sbj".
	      then have cph: "causal_program_history issbj ?suspends"
		apply -
		apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply (simp add: split_suspendsj)
		done

	      from valid_last_prog [OF j_bound tssb_j] have last_prog: "last_prog pj sbj = pj".
	      then
	      have lp: "last_prog pj ?suspends = pj"
		apply -
		apply (rule last_prog_same_append [where sb="?take_sbj"])
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done

	      from valid_reads [OF j_bound tssb_j]
	      have reads_consis: "reads_consistent False 𝒪j msb sbj".
	      from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb 
		j_bound
		tssb_j this]
	      have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		by (simp add: m suspendsj)

	      from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound tssb_j]
	      have nvo_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j sbj".
	      with non_volatile_owned_or_read_only_append [of False 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
	      have nvo_take_j: "non_volatile_owned_or_read_only False 𝒮sb 𝒪j ?take_sbj"
		by auto

	      from a_unowned_others [rule_format, OF _ neq_i_j] tssb_j j_bound
	      have a_not_acq: "a  acquired True ?take_sbj 𝒪j"
		by auto

	      from a_notin_unforwarded_non_volatile_reads_drop[OF j_bound tssb_j neq_i_j]
	      have a_notin_unforwarded_reads: "a  unforwarded_non_volatile_reads suspendsj {}"
		by (simp add: suspendsj)
	      
	      let ?ma="(m(a := f (θsb(tm a))))"

	      from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads [where W="{}" 
		and m'="?ma",simplified, OF _ subset_refl reads_consis_m_j] 
		a_notin_unforwarded_reads
	      have reads_consis_ma_j: 
		"reads_consistent True (acquired True ?take_sbj 𝒪j) ?ma suspendsj"
		by auto

	      from reads_consis_ma_j 
	      have reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j) ?ma (ys)"
		by (simp add: split_suspendsj reads_consistent_append)

	      from direct_memop_step.RMWWrite [where cond=cond and θ=θsb and m=m, OF cond' ]
	      have "(RMW a t (D, f) cond ret A L R W# issb', θsb, (), m, 𝒟,𝒪sb,sb,𝒮)  
                (issb', θsb(t  ret (m a) (f (θsb(t  m a)))), (), ?ma, False, 𝒪sb  A - R,Map.empty, 𝒮W RA L)".
	      from direct_computation.concurrent_step.Memop [OF i_bound' ts_i  this] 
	      have step_a: "(ts, m, 𝒮) d 
                (ts[i := (psb, issb', θsb(t  ret (m a) (f (θsb(t  m a)))), (), False, 𝒪sb  A - R,Map.empty)], 
                ?ma,𝒮W RA L)"
		(is " _ d (?ts_a, _, ?shared_a)").

	      from tsj neq_i_j j_bound 

	      have ts_a_j: "?ts_a!j = (hd_prog pj suspendsj, isj,
		θsbj |` (dom θsbj - read_tmps suspendsj),(), 𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
		by auto


	      from valid_write_sops [OF j_bound tssb_j]
	      have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		valid_sops_drop: "sopwrite_sops (ys). valid_sop sop"
		apply (simp only: write_sops_append)
		apply auto
		done

	      from read_tmps_distinct [OF j_bound tssb_j]
	      have "distinct_read_tmps (?take_sbj@suspendsj)"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain 
		read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
		distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		apply (simp only: distinct_read_tmps_append)
		done
	      
	      from valid_history [OF j_bound tssb_j]
	      have h_consis: 
		"history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done
	      
	      have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	      proof -
		from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		  by simp
		from last_prog_hd_prog_append' [OF h_consis] this
		have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		  by (simp only: split_suspendsj [symmetric] suspendsj) 
		moreover 
		have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		  last_prog (hd_prog pj suspendsj) ?take_sbj"
		  apply (simp only: split_suspendsj [symmetric] suspendsj) 
		  by (rule last_prog_hd_prog_append)
		ultimately show ?thesis
		  by (simp add: split_suspendsj [symmetric] suspendsj) 
	      qed

	      from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
		h_consis] last_prog_hd_prog
	      have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      from reads_consistent_drop_volatile_writes_no_volatile_reads  
	      [OF reads_consis] 
	      have no_vol_read: "outstanding_refs is_volatile_Readsb (ys) = {}"
		by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		  split_suspendsj )

	      from j_bound leq have j_bound_ts_a: "j < length ?ts_a" by auto
	      

	      
	      from flush_store_buffer_append [where sb="ys" and sb'="Readsb False a' t' v'#zs", simplified,
		OF j_bound_ts_a isj [simplified split_suspendsj] cph [simplified suspendsj]
		ts_a_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys
 		hist_consis' [simplified split_suspendsj] valid_sops_drop 
		distinct_read_tmps_drop [simplified split_suspendsj] 
		no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
		𝒮="?shared_a"]

	      obtain isj' j' where
		isj': "Read False a' t'# instrs zs @ issbj = isj' @ prog_instrs zs" and
		steps_ys: "(?ts_a, ?ma, ?shared_a)  d* 
		(?ts_a[j:=(last_prog
                (hd_prog pj zs) ys,
		isj',
                θsbj |` (dom θsbj - insert t' (read_tmps zs)),
                (), 𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j')],
                flush ys (?ma),
                share ys (?shared_a))"
		(is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
		by (auto simp add: acquired_append)

	      from cph
	      have "causal_program_history issbj ((ys @ [Readsb False a' t' v']) @ zs)"
		by simp
	      from causal_program_history_suffix [OF this]
	      have cph': "causal_program_history issbj zs".	      
	      interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

	      from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
	      obtain isj''
		where isj': "isj' = Read False a' t'#isj''" and
		isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
		by clarsimp
	      
	      from i_bound' have i_bound_ys: "i < length ?ts_ys"
		by auto

	      from i_bound' neq_i_j 
	      have ts_ys_i: "?ts_ys!i = (psb, issb', 
		θsb(t  ret (m a) (f (θsb(t  m a)))),(), False, 𝒪sb  A - R,Map.empty)"
		by simp

	      from j_bound_ts_a have j_bound_ys: "j < length ?ts_ys"
		by auto
	      then have ts_ys_j: "?ts_ys!j = (last_prog (hd_prog pj zs) ys, Read False a' t'#isj'', θsbj |` (dom θsbj - insert t' (read_tmps zs)), (), 𝒟j  outstanding_refs is_volatile_Writesb ys  {}, 
		acquired True ys (acquired True ?take_sbj 𝒪j),j')"
		by (clarsimp simp add: isj')
	      note conflict_computation = r_rtranclp_rtranclp [OF step_a steps_ys]
	      
	      from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	      have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".


	      from safe_delayedE [OF this j_bound_ys ts_ys_j]
	      
	      have "a'  acquired True ys (acquired True ?take_sbj 𝒪j) 
		a'  read_only (share ys (𝒮W RA L))"
		apply cases
		apply (auto simp add: Let_def issb)
		done

	      with a'_unacq
	      have a'_ro: "a'  read_only (share ys (𝒮W RA L))"
		by auto
	      from a'_in
	      have a'_not_ro: "a'  read_only (𝒮W RA L)"
		by (auto simp add:  in_read_only_convs)

	      have "a'  𝒪j  all_acquired sbj"
	      proof -
		{
		  assume a_notin: "a'  𝒪j  all_acquired sbj"
		  from weak_sharing_consis [OF j_bound tssb_j]
		  have "weak_sharing_consistent 𝒪j sbj".
		  with weak_sharing_consistent_append [of 𝒪j ?take_sbj ?drop_sbj]
		  have "weak_sharing_consistent (acquired True ?take_sbj 𝒪j) suspendsj"
		    by (auto simp add: suspendsj)
		  with split_suspendsj
		  have weak_consis: "weak_sharing_consistent (acquired True ?take_sbj 𝒪j) ys"
		    by (simp add: weak_sharing_consistent_append)
		  from all_acquired_append [of ?take_sbj ?drop_sbj]
		  have "all_acquired ys  all_acquired sbj"
		    apply (clarsimp)
		    apply (clarsimp simp add: suspendsj [symmetric] split_suspendsj all_acquired_append)
		    done
	          with a_notin acquired_takeWhile_non_volatile_Writesb [of sbj 𝒪j]
                    all_acquired_append [of ?take_sbj ?drop_sbj]
		  have "a'  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j  all_acquired ys"
                    by auto
                
		  from read_only_share_unowned [OF weak_consis this a'_ro] 
		  have "a'  read_only (𝒮W RA L)" .
		  
		  with a'_not_ro have False
		    by auto	  
		  with a_notin read_only_share_unowned [OF weak_consis _ a'_ro] 
		    all_acquired_takeWhile [of "(Not  is_volatile_Writesb)" sbj]

		  have "a'  read_only (𝒮W RA L)"
		    by (auto simp add: acquired_takeWhile_non_volatile_Writesb)
		  with a'_not_ro have False
		    by auto
		}
		thus ?thesis by blast
	      qed
	      
	      moreover
	      from A_unacquired_by_others [rule_format, OF _ neq_i_j] tssb_j j_bound
	      have "A  all_acquired sbj = {}"
		by (auto simp add: Let_def)
	      moreover
	      from A_unowned_by_others [rule_format, OF _ neq_i_j] tssb_j j_bound
	      have "A  𝒪j = {}"
	        by (auto simp add: Let_def dest: all_shared_acquired_in)
	      moreover note a'_in
	      ultimately
	      show False
		by auto
	    qed
	  }
	  thus ?thesis
	    by (auto simp add: Let_def)
	qed
      } note A_no_read_only_reads = this	      
	    
      have valid_own': "valid_ownership 𝒮sb' tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	proof 
	  fix j isj 𝒪j j 𝒟j θj sbj pj
	  assume j_bound: "j < length tssb'"
	  assume tssb'_j: "tssb'!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	  show "non_volatile_owned_or_read_only False 𝒮sb' 𝒪j sbj"
	  proof (cases "j=i")
	    case True
	    have "non_volatile_owned_or_read_only False 
	      (𝒮sbW RA L) (𝒪sb  A - R) []"
	      by simp
	    then show ?thesis
	      using True i_bound tssb'_j
	      by (auto simp add: tssb' 𝒮sb' sb sb')
	  next
	    case False
	    from j_bound have j_bound': "j < length tssb"
	      by (auto simp add: tssb')
	    with tssb'_j False i_bound 
	    have tssb_j: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	      by (auto simp add: tssb')


	    note nvo = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' tssb_j]

	    from read_only_unowned [OF i_bound tssb_i] R_owned
	    have "R  read_only 𝒮sb = {}"
	      by auto
	    with A_no_read_only_reads [OF j_bound' tssb_j False [symmetric]] L_subset
	    have "aread_only_reads
	      (acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j)
	      (dropWhile (Not  is_volatile_Writesb) sbj).
		a  read_only 𝒮sb  a  read_only (𝒮sbW RA L)"
	      by (auto simp add: in_read_only_convs)
	    from non_volatile_owned_or_read_only_read_only_reads_eq' [OF nvo this]
	    have "non_volatile_owned_or_read_only False (𝒮sbW RA L) 𝒪j sbj".
	    thus ?thesis by (simp add: 𝒮sb')
	  qed
	qed
      next
	show "outstanding_volatile_writes_unowned_by_others tssb'"
	proof (unfold_locales)
	  fix i1 j p1 "is1" 𝒪1 1 𝒟1 xs1 sb1 pj "isj" "𝒪j" j 𝒟j xsj sbj
	  assume i1_bound: "i1 < length tssb'"
	  assume j_bound: "j < length tssb'"
	  assume i1_j: "i1  j"
	  assume ts_i1: "tssb'!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	  assume ts_j: "tssb'!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb1 = {}"
	  proof (cases "i1=i")
	    case True
	    with ts_i1 i_bound show ?thesis
	      by (simp add: tssb' sb' sb)
	  next
	    case False
	    note i1_i = this
	    from i1_bound have i1_bound': "i1 < length tssb"
	      by (simp add: tssb' sb' sb)
	    hence i1_bound'': "i1 < length (map owned tssb)"
	      by auto
	    from ts_i1 False have ts_i1': "tssb!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	      by (simp add: tssb' sb' sb)
	    show ?thesis
	    proof (cases "j=i")
	      case True

	      from i_bound ts_j tssb' True have sbj: "sbj=[]"
		by (simp add: tssb' sb')
	      from A_unused_by_others [rule_format, OF _ False [symmetric]] ts_i1 i1_bound''
		False i1_bound'
	      have "A  (𝒪1  outstanding_refs is_volatile_Writesb sb1) = {}"
		by (auto simp add: Let_def tssb' 𝒪sb' sb' owned_def)
	      moreover
	      from outstanding_volatile_writes_unowned_by_others 
	      [OF i1_bound' i_bound i1_i ts_i1' tssb_i]
	      have "𝒪sb  outstanding_refs is_volatile_Writesb sb1 = {}" by (simp add: sb)
	      
	      ultimately show ?thesis using ts_j True 
		by (auto simp add: i_bound tssb' 𝒪sb' sbj)
	    next
	      case False
	      from j_bound have j_bound': "j < length tssb"
		by (simp add: tssb')
	      from ts_j False have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (simp add: tssb')
	      from outstanding_volatile_writes_unowned_by_others 
              [OF i1_bound' j_bound' i1_j ts_i1' ts_j']
	      show "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb1 = {}" .
	    qed
	  qed
	qed
      next
	show "read_only_reads_unowned tssb'"
	proof 
	  fix n m
	  fix pn "isn" 𝒪n n 𝒟n θn sbn pm "ism" 𝒪m m 𝒟m θm sbm
	  assume n_bound: "n < length tssb'"
	    and m_bound: "m < length tssb'"
	    and neq_n_m: "nm"
	    and nth: "tssb'!n = (pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
	    and mth: "tssb'!m =(pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
	  from n_bound have n_bound': "n < length tssb" by (simp add: tssb')
	  from m_bound have m_bound': "m < length tssb" by (simp add: tssb')
	  show "(𝒪m  all_acquired sbm) 
            read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbn) 𝒪n)
            (dropWhile (Not  is_volatile_Writesb) sbn) =
            {}"
	  proof (cases "m=i")
	    case True
	    with neq_n_m have neq_n_i: "ni"
	      by auto
	    
	    with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
	      by (auto simp add: tssb')
	    note read_only_reads_unowned [OF n_bound' i_bound  neq_n_i nth' tssb_i]
	    moreover
	    note A_no_read_only_reads [OF n_bound' nth']
	    ultimately
	    show ?thesis
	      using True tssb_i neq_n_i nth mth n_bound' m_bound'
	      by (auto simp add: tssb' 𝒪sb' sb sb')
	  next
	    case False
	    note neq_m_i = this
	    with m_bound mth i_bound have mth': "tssb!m = (pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
	      by (auto simp add: tssb')
	    show ?thesis
	    proof (cases "n=i")
	      case True
	      with tssb_i nth mth neq_m_i n_bound' 
	      show ?thesis
		by (auto simp add: tssb'  sb')
	    next
	      case False
	      with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
		by (auto simp add: tssb')
	      from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m  nth' mth'] False neq_m_i
	      show ?thesis 
		by (clarsimp)
	    qed
	  qed
	qed
      next
	show "ownership_distinct tssb'"
	proof (unfold_locales)
	  fix i1 j p1 "is1" 𝒪1 1 𝒟1 xs1 sb1 pj "isj" "𝒪j" j 𝒟j xsj sbj
	  assume i1_bound: "i1 < length tssb'"
	  assume j_bound: "j < length tssb'"
	  assume i1_j: "i1  j"
	  assume ts_i1: "tssb'!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	  assume ts_j: "tssb'!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "(𝒪1  all_acquired sb1)  (𝒪j  all_acquired sbj)= {}"
	  proof (cases "i1=i")
	    case True
	    with i1_j have i_j: "ij" 
	      by simp
	    
	    from i_bound ts_i1 tssb' True have sb1: "sb1=[]"
	      by (simp add: tssb' sb')
	    from j_bound have j_bound': "j < length tssb"
	      by (simp add: tssb')
	    hence j_bound'': "j < length (map owned tssb)"
	      by simp	    
	    from ts_j i_j have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (simp add: tssb')
	    
	    from A_unused_by_others [rule_format, OF _ i_j] ts_j i_j j_bound'
	    have "A  (𝒪j  outstanding_refs is_volatile_Writesb sbj) = {}"
	      by (auto simp add: Let_def tssb' owned_def)
	    moreover
	    from A_unacquired_by_others [rule_format, OF _ i_j] ts_j i_j j_bound'
	    have "A  all_acquired sbj = {}"
	      by (auto simp add: Let_def tssb')
(*
	    from a_not_acquired_others [rule_format, OF j_bound'' i_j] ts_j i_j j_bound'
	    have "a ∉ all_acquired sbj"
	      by (auto simp add: Let_def tssb')
*)
	    moreover
	    from ownership_distinct [OF i_bound j_bound' i_j tssb_i ts_j']
	    have "𝒪sb  (𝒪j  all_acquired sbj)= {}" by (simp add: sb)
	    ultimately show ?thesis using ts_i1 True
	      by (auto simp add: i_bound tssb' 𝒪sb' sb' sb1)
	  next
	    case False
	    note i1_i = this
	    from i1_bound have i1_bound': "i1 < length tssb"
	      by (simp add: tssb')
	    hence i1_bound'': "i1 < length (map owned tssb)"
	      by simp	    
	    from ts_i1 False have ts_i1': "tssb!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	      by (simp add: tssb')
	    show ?thesis
	    proof (cases "j=i")
	      case True
	      from A_unused_by_others [rule_format, OF _ False [symmetric]] ts_i1  
		False i1_bound'
	      have "A  (𝒪1  outstanding_refs is_volatile_Writesb sb1) = {}"
		by (auto simp add: Let_def tssb' owned_def)
	      moreover
	      from A_unacquired_by_others [rule_format, OF _ False [symmetric]] ts_i1  False i1_bound'
	      have "A  all_acquired sb1 = {}"
		by (auto simp add: Let_def tssb' owned_def)
	      moreover
	      from ownership_distinct [OF i1_bound' i_bound i1_i ts_i1' tssb_i]
	      have "(𝒪1  all_acquired sb1)  𝒪sb = {}" by (simp add: sb)
	      ultimately show ?thesis
		using ts_j True
		by (auto simp add: i_bound tssb' 𝒪sb' sb')
	    next
	      case False
	      from j_bound have j_bound': "j < length tssb"
		by (simp add: tssb')
	      from ts_j False have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (simp add: tssb')
	      from ownership_distinct [OF i1_bound' j_bound' i1_j ts_i1' ts_j']
	      show "(𝒪1  all_acquired sb1)  (𝒪j  all_acquired sbj) = {}" .
	    qed
	  qed
	qed
      qed

      have valid_hist': "valid_history program_step tssb'"
      proof -
	from valid_history [OF i_bound tssb_i] 
	have "history_consistent (θsb(tret (msb a) (f (θsb(tmsb a))))) (hd_prog psb []) []" by simp
	from valid_history_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' θsb' sb' sb)
      qed

      from valid_reads [OF i_bound tssb_i]
      have reads_consis: "reads_consistent False 𝒪sb msb sb" .

      have valid_reads': "valid_reads msb' tssb'"
      proof (unfold_locales)
	fix j pj "isj" 𝒪j j 𝒟j acqj θj sbj
	assume j_bound: "j < length tssb'"
	assume ts_j: "tssb'!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	show "reads_consistent False 𝒪j msb' sbj"
	proof (cases "i=j")
	  case True
	  from reads_consis ts_j j_bound sb show ?thesis
	    by (clarsimp simp add: True  msb' Writesb tssb' sb')
	next
	  case False
	  from j_bound have j_bound':  "j < length tssb"
	    by (simp add: tssb')
	  moreover from ts_j False have ts_j': "tssb ! j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	    using j_bound by (simp add: tssb')
	  ultimately have consis_m: "reads_consistent False 𝒪j msb sbj"
	    by (rule valid_reads)
	  let ?m' = "(msb(a := f (θsb(t  msb a))))"
	  from a_unowned_others [rule_format, OF _ False] j_bound' ts_j'
          obtain a_acq: "a  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j" and
          a_unsh: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)"
            by auto
          with a_notin_unforwarded_non_volatile_reads_drop [OF j_bound' ts_j' False]
	  have "aacquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j  
                   all_shared (takeWhile (Not  is_volatile_Writesb) sbj)  
	           unforwarded_non_volatile_reads (dropWhile (Not  is_volatile_Writesb) sbj) {}. 
	    ?m' a = msb a"
	    by auto
	  from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads_drop 
	  [where W="{}",simplified, OF this _ _ consis_m] 
	    acquired_reads_all_acquired' [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 𝒪j]
	  have "reads_consistent False 𝒪j (msb(a := f (θsb(t  msb a)))) sbj"
	    by (auto simp del: fun_upd_apply)
	  thus ?thesis 
	    by (simp add: msb')
	qed
      qed

      have valid_sharing': "valid_sharing (𝒮sbW RA L) tssb'"
      proof (intro_locales)	
	show "outstanding_non_volatile_writes_unshared (𝒮sbW RA L) tssb'"
	proof (unfold_locales)
	  fix j pj "isj" "𝒪j" j 𝒟j acqj xsj sbj
	  assume j_bound: "j < length tssb'"
	  assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "non_volatile_writes_unshared (𝒮sbW RA L)  sbj"
	  proof (cases "i=j")
	    case True
	    with i_bound jth show ?thesis
	      by (simp add: tssb' sb' sb)
	  next
	    case False
	    from j_bound have j_bound': "j < length tssb"
	      by (auto simp add: tssb')
	    from jth False have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (auto simp add: tssb')
	    from outstanding_non_volatile_writes_unshared [OF j_bound' jth']
	    have unshared: "non_volatile_writes_unshared 𝒮sb sbj".
	    have "adom (𝒮sbW RA L) - dom 𝒮sb. a  outstanding_refs is_non_volatile_Writesb sbj"
	    proof -
	      { 
		fix a 
		assume a_in: "a  dom (𝒮sbW RA L) - dom 𝒮sb"
		hence a_R: "a  R"
		  by clarsimp
		assume a_in_j: "a  outstanding_refs is_non_volatile_Writesb sbj"
		have False
		proof -
		  from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF
		  outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
		  a_in_j
		  have "a  𝒪j  all_acquired sbj"
		    by auto
		  moreover
		  with ownership_distinct [OF i_bound j_bound' False tssb_i jth'] a_R R_owned
		  show False
		    by blast
		qed
	      }
	      thus ?thesis by blast
	    qed
		 
	    from non_volatile_writes_unshared_no_outstanding_non_volatile_Writesb 
	    [OF unshared this]
	    show ?thesis .
	  qed
	qed
      next
	show "sharing_consis (𝒮sbW RA L) tssb'"
	proof (unfold_locales)  
	  fix j pj "isj" "𝒪j" j 𝒟j acqj xsj sbj
	  assume j_bound: "j < length tssb'"
	  assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "sharing_consistent (𝒮sbW RA L) 𝒪j sbj"
	  proof (cases "i=j")
	    case True
	    with i_bound jth show ?thesis
	      by (simp add: tssb' sb' sb)
	  next
	    case False
	    from j_bound have j_bound': "j < length tssb"
	      by (auto simp add: tssb')
	    from jth False have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (auto simp add: tssb')
	    from sharing_consis [OF j_bound' jth']
	    have consis: "sharing_consistent 𝒮sb 𝒪j sbj".

	    have acq_cond: "all_acquired sbj  dom 𝒮sb - dom (𝒮sbW RA L) = {}"
	    proof -
	      {
		fix a
		assume a_acq: "a  all_acquired sbj" 
		assume "a  dom 𝒮sb" 
		assume a_L: "a  L"
		have False
		proof -
		  from A_unacquired_by_others [rule_format, of j,OF _ False] j_bound' jth'
		  have "A  all_acquired sbj = {}"
		    by auto
		  with a_acq a_L L_subset
		  show False
		    by blast
		qed
	      }
	      thus ?thesis
		by auto
	    qed
	    have uns_cond: "all_unshared sbj  dom (𝒮sbW RA L) - dom 𝒮sb = {}"
	    proof -
	      {
		fix a
		assume a_uns: "a  all_unshared sbj" 
		assume "a  L" 
		assume a_R:  "a  R"
		have False
		proof -
		  from unshared_acquired_or_owned [OF consis] a_uns
		  have "a  all_acquired sbj  𝒪j" by auto
		  with ownership_distinct [OF i_bound j_bound' False tssb_i jth']  R_owned a_R
		  show False
		    by blast
		qed
	      }
	      thus ?thesis
		by auto
	    qed

	    from sharing_consistent_preservation [OF consis acq_cond uns_cond]
	    show ?thesis
	      by (simp add: tssb')
	  qed
	qed
      next
	show "unowned_shared (𝒮sbW RA L) tssb'"
	proof (unfold_locales)
	  show "- ((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set tssb')  dom (𝒮sbW RA L)"
	  proof -

	    have s: "((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set tssb') =
              ((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set tssb)  A - R"
	      
	      apply (unfold tssb' 𝒪sb') 
	      apply (rule acquire_release_ownership_nth_update [OF R_owned i_bound tssb_i])
	      apply fact
	      done

	    note unowned_shared L_subset A_R
	    then
	    show ?thesis
	      apply (simp only: s)
	      apply auto
	      done
	  qed
	qed
      next
	show "read_only_unowned (𝒮sbW RA L) tssb'"
	proof 
	  fix j pj "isj" "𝒪j" j 𝒟j acqj xsj sbj
	  assume j_bound: "j < length tssb'"
	  assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "𝒪j  read_only (𝒮sbW RA L) = {}"
	  proof (cases "i=j")
	    case True
	    from read_only_unowned [OF i_bound tssb_i] R_owned  A_R 
	    have "(𝒪sb  A - R)  read_only (𝒮sbW RA L) = {}"
	      by (auto simp add: in_read_only_convs )
	    with jth tssb_i i_bound True
	    show ?thesis
	      by (auto simp add: 𝒪sb' tssb')
	  next
	    case False
	    from j_bound have j_bound': "j < length tssb"
	      by (auto simp add: tssb')
	    with False jth have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (auto simp add: tssb')
	    from read_only_unowned [OF j_bound' jth']
	    have "𝒪j  read_only 𝒮sb = {}".
	    moreover
	    from A_unowned_by_others [rule_format, OF _ False] j_bound' jth'
	    have "A  𝒪j = {}"
	      by (auto dest: all_shared_acquired_in )
	    moreover
	    from ownership_distinct [OF i_bound j_bound' False tssb_i jth']
	    have "𝒪sb  𝒪j = {}"
	      by auto
	    moreover note R_owned A_R
	    ultimately show ?thesis
	      by (fastforce simp add: in_read_only_convs split: if_split_asm)
	  qed
	qed
      next
	show "no_outstanding_write_to_read_only_memory (𝒮sbW RA L) tssb'"
	proof 
	  fix j pj "isj" "𝒪j" j 𝒟j acqj xsj sbj
	  assume j_bound: "j < length tssb'"
	  assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "no_write_to_read_only_memory (𝒮sbW RA L) sbj"
	  proof (cases "i=j")
	    case True
	    with jth tssb_i i_bound 
	    show ?thesis
	      by (auto simp add: sb sb' tssb')
	  next
	    case False
	    from j_bound have j_bound': "j < length tssb"
	      by (auto simp add: tssb')
	    with False jth have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (auto simp add: tssb')
	    from no_outstanding_write_to_read_only_memory [OF j_bound' jth']
	    have nw: "no_write_to_read_only_memory 𝒮sb sbj".
	    have "R  outstanding_refs is_Writesb sbj = {}"
	    proof -
	      note dist = ownership_distinct [OF i_bound j_bound' False tssb_i jth']
	      from non_volatile_owned_or_read_only_outstanding_non_volatile_writes 
	      [OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
		dist
	      have "outstanding_refs is_non_volatile_Writesb sbj  𝒪sb = {}"
		by auto
	      moreover
	      from outstanding_volatile_writes_unowned_by_others [OF j_bound'  i_bound 
		False [symmetric] jth' tssb_i ]
	      have "outstanding_refs is_volatile_Writesb sbj  𝒪sb = {}" 
		by auto
	      ultimately have "outstanding_refs is_Writesb sbj  𝒪sb = {}" 
		by (auto simp add: misc_outstanding_refs_convs)
	      with R_owned
	      show ?thesis by blast
	    qed
	    then
	    have "aoutstanding_refs is_Writesb sbj.
	      a  read_only (𝒮sbW RA L)  a  read_only 𝒮sb"
	      by (auto simp add: in_read_only_convs) 

	    from no_write_to_read_only_memory_read_only_reads_eq [OF nw this]
	    show ?thesis .
	  qed
	qed
      qed

      have tmps_distinct': "tmps_distinct tssb'"
      proof (intro_locales)
	from load_tmps_distinct [OF i_bound tssb_i]
	have "distinct_load_tmps issb'" 
	  by (auto simp add: "issb" split: instr.splits)
	from load_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_distinct tssb'" by (simp add: tssb' sb' sb 𝒪sb' "issb")
      next
	from read_tmps_distinct [OF i_bound tssb_i]
	have "distinct_read_tmps []" by (simp add: tssb' sb' sb 𝒪sb')
	from read_tmps_distinct_nth_update [OF i_bound this]
	show "read_tmps_distinct tssb'" by (simp add: tssb' sb' sb 𝒪sb')
      next
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i] 
          load_tmps_distinct [OF i_bound tssb_i]
	have "load_tmps issb'  read_tmps [] = {}"
	  by (clarsimp)
	from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_read_tmps_distinct tssb'"  by (simp add: tssb' sb' sb 𝒪sb')
      qed

      have valid_sops': "valid_sops tssb'"
      proof -
	from valid_store_sops [OF i_bound tssb_i]
	obtain 
	  valid_store_sops': "sopstore_sops issb'. valid_sop sop"
	  by (auto simp add: "issb" tssb' sb' sb 𝒪sb')

	from valid_sops_nth_update [OF i_bound  _ valid_store_sops', where sb= "[]" ]
	show ?thesis by (auto simp add: tssb' sb' sb 𝒪sb')
      qed

      have valid_dd': "valid_data_dependency tssb'"
      proof -
	from data_dependency_consistent_instrs [OF i_bound tssb_i]
	obtain 
	  dd_is: "data_dependency_consistent_instrs (dom θsb')  issb'"
	  by (auto simp add: "issb" θsb')
	from load_tmps_write_tmps_distinct [OF i_bound tssb_i] 
	have "load_tmps issb'  (fst ` write_sops [])  = {}"
	  by (auto simp add: write_sops_append)
	from valid_data_dependency_nth_update [OF i_bound dd_is this]
	show ?thesis by (simp add: tssb' sb' sb 𝒪sb')
      qed

      have load_tmps_fresh': "load_tmps_fresh tssb'"
      proof -
	from load_tmps_fresh [OF i_bound tssb_i] 
	have "load_tmps (RMW a t (D,f) cond ret A L R W # issb')  dom θsb = {}"
	  by (simp add: "issb")
	moreover
	from load_tmps_distinct [OF i_bound tssb_i] have "t  load_tmps issb'"
	  by (auto simp add: "issb")
	ultimately have "load_tmps issb'  dom (θsb(t  ret (msb a) (f (θsb(tmsb a))))) = {}"
	  by auto
	from load_tmps_fresh_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' θsb')
      qed

      from enough_flushs_nth_update [OF i_bound, where sb="[]" ]
      have enough_flushs': "enough_flushs tssb'"
	by (auto simp: tssb' sb' sb)


      have valid_program_history': "valid_program_history tssb'"
      proof -	
	have causal': "causal_program_history issb' sb'"
	  by (simp add: "issb" sb sb')
	have "last_prog psb sb' = psb"
	  by (simp add: sb' sb)
	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb' sb')
      qed

      from is_sim have "is": "is = RMW a t (D,f) cond ret A L R W # issb'"
	by (simp add: suspends sb "issb")

      from direct_memop_step.RMWWrite [where cond=cond and θ=θsb and m=m, OF cond']
      have "(RMW a t (D, f) cond ret A L R W # issb', θsb, (),m, 𝒟, 𝒪sb,sb, 𝒮)  
            (issb',θsb(t  ret (m a) (f (θsb(tm a)))), (), 
             m(a := f (θsb(t  m a))), False, 𝒪sb  A - R, Map.empty, 𝒮W RA L)".

      from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
      have "(ts, m, 𝒮) d (ts[i := (psb, issb',θsb(t  ret (m a) (f (θsb(tm a)))), (), False, 𝒪sb  A - R,Map.empty)], 
             m(a := f (θsb(t  m a))),𝒮W RA L)".

      moreover 

      have tmps_commute: "θsb(t  ret (msb a) (f (θsb(tmsb a)))) = 
	(θsb |` (dom θsb - {t}))(t  ret (msb a) (f (θsb(tmsb a))))"
	apply (rule ext)
	apply (auto simp add: restrict_map_def domIff)
	done

	 
      from a_unflushed tssb_i sb
      have a_unflushed':
	"j < length tssb. 
                  (let (_,_,_,sbj,_,_,_) = tssb!j 
                  in a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))"
	by auto

      have all_shared_L: "i p is 𝒪  𝒟 acq θ sb. i < length tssb 
            tssb ! i = (p, is, θ, sb, 𝒟, 𝒪,) 
            all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {}"
      proof -
	{
	  fix j pj isj 𝒪j j 𝒟j θj sbj x
	  assume j_bound: "j < length tssb"
	  assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	  assume x_shared: "x  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)"
	  assume x_L: "x  L"
	  have False
	  proof (cases "i=j")
	    case True with x_shared tssb_i jth show False by (simp add: sb)
	  next
	    case False
	    show False
	    proof -
	      from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
	      have "all_shared sbj  all_acquired sbj  𝒪j".

	      moreover have "all_shared (takeWhile (Not  is_volatile_Writesb) sbj)  all_shared sbj"
		using all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
		  "(dropWhile (Not  is_volatile_Writesb) sbj)"]
		by auto
	      moreover
	      from A_unacquired_by_others [rule_format, OF _ False] jth j_bound
	      have "A  all_acquired sbj = {}" by auto
	      moreover

	      from A_unowned_by_others [rule_format, OF _ False] jth j_bound
	      have "A  𝒪j = {}"
	        by (auto dest: all_shared_acquired_in)

	      ultimately
	      show False
		using L_subset x_L x_shared
		by blast
	    qed
	  qed
	}
	thus ?thesis by blast
      qed

      have all_shared_A: "i p is 𝒪  𝒟 θ sb. i < length tssb 
            tssb ! i = (p, is, θ, sb, 𝒟, 𝒪,) 
            all_shared (takeWhile (Not  is_volatile_Writesb) sb)  A = {}"
      proof -
	{
	  fix j pj isj 𝒪j j 𝒟j θj sbj x
	  assume j_bound: "j < length tssb"
	  assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	  assume x_shared: "x  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)"
	  assume x_A: "x  A"
	  have False
	  proof (cases "i=j")
	    case True with x_shared tssb_i jth show False by (simp add: sb)
	  next
	    case False
	    show False
	    proof -
	      from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
	      have "all_shared sbj  all_acquired sbj  𝒪j".

	      moreover have "all_shared (takeWhile (Not  is_volatile_Writesb) sbj)  all_shared sbj"
		using all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
		  "(dropWhile (Not  is_volatile_Writesb) sbj)"]
		by auto
	      moreover
	      from A_unacquired_by_others [rule_format, OF _ False] jth j_bound
	      have "A  all_acquired sbj = {}" by auto
	      moreover

	      from A_unowned_by_others [rule_format, OF _ False] jth j_bound
	      have "A  𝒪j = {}"
	        by (auto dest: all_shared_acquired_in)


	      ultimately
	      show False
		using x_A x_shared 
		by blast
	    qed
	  qed
	}
	thus ?thesis by blast
      qed
      hence all_shared_L: "i p is 𝒪  𝒟 θ sb. i < length tssb 
            tssb ! i = (p, is, θ, sb, 𝒟, 𝒪,) 
            all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {}"
	using L_subset by blast

     have all_unshared_R: "i p is 𝒪  𝒟 θ sb. i < length tssb 
            tssb ! i = (p, is, θ, sb, 𝒟, 𝒪,) 
            all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}"
      proof -
	{
	  fix j pj isj 𝒪j j 𝒟j θj sbj x
	  assume j_bound: "j < length tssb"
	  assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	  assume x_unshared: "x  all_unshared (takeWhile (Not  is_volatile_Writesb) sbj)"
	  assume x_R: "x  R"
	  have False
	  proof (cases "i=j")
	    case True with x_unshared tssb_i jth show False by (simp add: sb)
	  next
	    case False
	    show False
	    proof -
	      from unshared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
	      have "all_unshared sbj  all_acquired sbj  𝒪j".

	      moreover have "all_unshared (takeWhile (Not  is_volatile_Writesb) sbj)  all_unshared sbj"
		using all_unshared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
		  "(dropWhile (Not  is_volatile_Writesb) sbj)"]
		by auto
	      moreover

	      note ownership_distinct [OF i_bound j_bound False tssb_i jth]

	      ultimately
	      show False
		using  R_owned x_R x_unshared
		by blast
	    qed
	  qed
	}
	thus ?thesis by blast
      qed

     have all_acquired_R: "i p is 𝒪  𝒟 θ sb. i < length tssb 
            tssb ! i = (p, is, θ, sb, 𝒟, 𝒪,) 
            all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  R = {}"
      proof -
	{
	  fix j pj isj 𝒪j j 𝒟j θj sbj x
	  assume j_bound: "j < length tssb"
	  assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	  assume x_acq: "x  all_acquired (takeWhile (Not  is_volatile_Writesb) sbj)"
	  assume x_R: "x  R"
	  have False
	  proof (cases "i=j")
	    case True with x_acq tssb_i jth show False by (simp add: sb)
	  next
	    case False
	    show False
	    proof -

	      from x_acq have "x  all_acquired sbj"
		using all_acquired_append [of "takeWhile (Not  is_volatile_Writesb) sbj" 
		  "dropWhile (Not  is_volatile_Writesb) sbj"]
		by auto
	      moreover
	      note ownership_distinct [OF i_bound j_bound False tssb_i jth]
	      ultimately
	      show False
		using  R_owned x_R 
		by blast
	    qed
	  qed
	}
	thus ?thesis by blast
      qed

      have all_shared_R: "i p is 𝒪  𝒟 θ sb. i < length tssb 
            tssb ! i = (p, is, θ, sb, 𝒟, 𝒪,) 
            all_shared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}"
      proof -
	{
	  fix j pj isj 𝒪j j 𝒟j θj sbj x
	  assume j_bound: "j < length tssb"
	  assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	  assume x_shared: "x  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)"
	  assume x_R: "x  R"
	  have False
	  proof (cases "i=j")
	    case True with x_shared tssb_i jth show False by (simp add: sb)
	  next
	    case False
	    show False
	    proof -
	      from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
	      have "all_shared sbj  all_acquired sbj  𝒪j".

	      moreover have "all_shared (takeWhile (Not  is_volatile_Writesb) sbj)  all_shared sbj"
		using all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
		  "(dropWhile (Not  is_volatile_Writesb) sbj)"]
		by auto
	      moreover
	      note ownership_distinct [OF i_bound j_bound False tssb_i jth]
	      ultimately 
	      show False
		using R_owned x_R x_shared
		by blast
	    qed
	  qed
	}
	thus ?thesis by blast
      qed

      from share_all_until_volatile_write_commute [OF ‹ownership_distinct tssb ‹sharing_consis 𝒮sb tssb 
	all_shared_L all_shared_A all_acquired_R all_unshared_R all_shared_R]
      have share_commute: "share_all_until_volatile_write tssb 𝒮sbW RA L =
        share_all_until_volatile_write tssb (𝒮sbW RA L)".

      {
	fix j pj isj 𝒪j j 𝒟j θj sbj x
	assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	assume j_bound: "j < length tssb"
        assume neq: "i  j" 

        have "release (takeWhile (Not  is_volatile_Writesb) sbj)
                            (dom 𝒮sb  R - L) j
              = release (takeWhile (Not  is_volatile_Writesb) sbj)
                            (dom 𝒮sb) j"
        proof -
          {
            fix a
            assume a_in: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)"
            have "(a  (dom 𝒮sb  R - L)) = (a  dom 𝒮sb)"
            proof -
              from A_unowned_by_others [rule_format, OF j_bound neq ] jth
              A_unacquired_by_others [rule_format, OF _ neq] j_bound
              have A_dist: "A  (𝒪j  all_acquired sbj) = {}"
                by (auto dest: all_shared_acquired_in)
              
              from  all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]] a_in
              all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
                "(dropWhile (Not  is_volatile_Writesb) sbj)"]
              have a_in: "a  𝒪j  all_acquired sbj"
                by auto
              with ownership_distinct [OF i_bound j_bound neq  tssb_i jth]
              have "a  (𝒪sb  all_acquired sb)" by auto

              
              with A_dist R_owned A_R A_shared_owned L_subset a_in
              obtain "a  R" and "a  L"
                by fastforce
              then show ?thesis by auto
            qed
          }
          then 
          show ?thesis 
            apply -
            apply (rule release_all_shared_exchange)
            apply auto
            done
        qed
      }
      note release_commute = this
      have "(tssb',msb(a := f (θsb(t  msb a))),𝒮sb')  (ts[i := (psb,issb',
            θsb(t  ret (m a) (f (θsb(tm a)))),(), False,𝒪sb  A - R,Map.empty)],m(a := f (θsb(t  m a))),𝒮W RA L)"
	apply (rule sim_config.intros)
	apply    (simp only: m_a )
	apply    (simp only: m)
	apply    (simp only: flush_all_until_volatile_write_update_other [OF a_unflushed', symmetric] tssb')
	apply    (simp add: flush_all_until_volatile_nth_update_unused [OF i_bound tssb_i, simplified sb] sb')
	apply    (simp add: tssb' sb' 𝒪sb' m 
	  flush_all_until_volatile_nth_update_unused [OF i_bound tssb_i, simplified sb])
	using  share_all_until_volatile_write_RMW_commute [OF i_bound tssb_i [simplified issb sb]]
	apply  (clarsimp simp add: 𝒮 tssb' 𝒮sb' issb 𝒪sb' ℛsb' θsb' sb' sb share_commute)
	using  leq
	apply  (simp add: tssb')
	using i_bound i_bound' ts_sim
	apply (clarsimp simp add: Let_def nth_list_update 
	  tssb' sb' sb 𝒪sb' ℛsb' 𝒮sb' θsb' 𝒟sb'  ex_not m_a  
	  split: if_split_asm)
        apply (rule conjI)
        apply  clarsimp
        apply  (rule tmps_commute)
        apply clarsimp
        apply (frule (2) release_commute)
        apply clarsimp
        apply fastforce
	done
      ultimately 
      show ?thesis
	using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_sops'
	  valid_dd' load_tmps_fresh' enough_flushs' 
	  valid_program_history' valid' msb' 𝒮sb' 
	by (auto simp del: fun_upd_apply)	
    next
      case (SBHGhost A L R W)
      then obtain 
	"issb": "issb = Ghost A L R W# issb'" and
	𝒪sb': "𝒪sb'=𝒪sb" andsb': "sb'=sb" and
	θsb': "θsb' = θsb" and
	𝒟sb': "𝒟sb'=𝒟sb" and
	sb': "sb'=sb@[Ghostsb A L R W]" and
	msb': "msb' = msb" and
	𝒮sb': "𝒮sb'=𝒮sb" 
	by auto

      from safe_memop_flush_sb [simplified issb] obtain      
        L_subset: "L  A" and
	A_shared_owned: "A  dom (share ?drop_sb 𝒮)  acquired True sb 𝒪sb" and
	R_acq: "R  acquired True sb 𝒪sb" and
	A_R: "A  R = {}" and
        A_unowned_by_others_ts:  
	"j<length (map owned ts). ij  (A  (owned (ts!j)  dom (released (ts!j))) = {})" 
	by cases auto

      from A_unowned_by_others_ts ts_sim leq
      have A_unowned_by_others:  
	"j<length tssb. ij  (let (_,_,_,sbj,_,𝒪j,_) = tssb!j 
	  in A  (acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j 
                  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)) = {})" 
  apply (clarsimp simp add: Let_def)
  subgoal for j
	apply (drule_tac x=j in spec)
	apply (force simp add: dom_release_takeWhile)
	done
  done
      have A_unused_by_others:
	  "j<length (map 𝒪_sb tssb). i  j 
             (let (𝒪j, sbj) = map 𝒪_sb tssb! j
             in A  outstanding_refs is_volatile_Writesb sbj = {})"
      proof -
	{
	  fix j 𝒪j sbj
	  assume j_bound: "j < length (map owned tssb)"
	  assume neq_i_j: "ij"
	  assume tssb_j: "(map 𝒪_sb tssb)!j = (𝒪j,sbj)"
	  assume conflict: "A  outstanding_refs is_volatile_Writesb sbj  {}"
	  have False
	  proof -
	    from j_bound leq
	    have j_bound': "j < length (map owned ts)"
	      by auto
	    from j_bound have j_bound'': "j < length tssb"
	      by auto
	    from j_bound' have j_bound''': "j < length ts"
	      by simp
	    
	    from conflict obtain a' where
	      a'_in: "a'  A" and
              a'_in_j: "a'  outstanding_refs is_volatile_Writesb sbj"
	      by auto

	    let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	    let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"

	    from ts_sim [rule_format, OF  j_bound''] tssb_j j_bound''
	    obtain pj suspendsj "issbj" θsbj 𝒟sbj 𝒟j j "isj" where
	      tssb_j: "tssb ! j = (pj,issbj,θsbj, sbj,𝒟sbj,𝒪j,j)" and
	      suspendsj: "suspendsj = ?drop_sbj" and
	      𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
	      isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	      tsj: "ts!j = (hd_prog pj suspendsj, isj,
	             θsbj |` (dom θsbj - read_tmps suspendsj),(), 
	             𝒟j, acquired True ?take_sbj 𝒪j, release ?take_sbj (dom 𝒮sb) j)"
	      apply (cases "tssb!j")
	      apply (force simp add: Let_def)
	      done
	      
	    have "a'  outstanding_refs is_volatile_Writesb suspendsj"
	    proof -	
	      from a'_in_j 
	      have "a'  outstanding_refs is_volatile_Writesb (?take_sbj @ ?drop_sbj)"
		by simp
	      thus ?thesis
		apply (simp only: outstanding_refs_append suspendsj)
		apply (auto simp add: outstanding_refs_conv dest: set_takeWhileD)
		done
	    qed
		
	    from split_volatile_Writesb_in_outstanding_refs [OF this]
	    obtain sop v ys zs A' L' R' W' where
	      split_suspendsj: "suspendsj = ys @ Writesb True a' sop v A' L' R' W' # zs" (is "suspendsj = ?suspends")
	      by blast
	    
	    from direct_memop_step.Ghost [where  θ=θsb and m="flush ?drop_sb m"]
	    have "(Ghost A L R W# issb', 
                       θsb, (), flush ?drop_sb m, 𝒟sb, 
                       acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb, share ?drop_sb 𝒮)  
                    (issb', θsb, (), flush ?drop_sb m, 𝒟sb, 
                      acquired True sb 𝒪sb  A - R, 
                      augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮sb) sb),
                      share ?drop_sb 𝒮W RA L)".
	   
	    from direct_computation.concurrent_step.Memop [OF 
	      i_bound_ts' [simplified issb] ts'_i [simplified issb] this [simplified issb]] 
	    have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) d 
                    (?ts'[i := (psb, issb', θsb, (),𝒟sb, acquired True sb 𝒪sb  A - R,augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮sb) sb))], 
                         flush ?drop_sb m,share ?drop_sb 𝒮W RA L)"
		  (is " _ d (?ts_A, ?m_A, ?share_A)")
	     by (simp add: issb)
	      
	       
	   from i_bound' have i_bound'': "i < length ?ts_A"
	     by simp

	   from valid_program_history [OF j_bound'' tssb_j] 
	   have "causal_program_history issbj sbj".
	   then have cph: "causal_program_history issbj ?suspends"
	     apply -
	     apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
	     apply (simp only: split_suspendsj [symmetric] suspendsj)
	     apply (simp add: split_suspendsj)
	     done
	   
	   from tsj neq_i_j j_bound 
	   have ts_A_j: "?ts_A!j = (hd_prog pj (ys @ Writesb True a' sop v A' L' R' W' # zs), isj,
	     θsbj |` (dom θsbj - read_tmps (ys @ Writesb True a' sop v A' L' R' W' # zs)), (), 𝒟j, 
	     acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	     by (simp add: split_suspendsj)


	   from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
	     by simp

	   from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
	   then
	   have lp: "last_prog pj ?suspends = pj"
	     apply -
	     apply (rule last_prog_same_append [where sb="?take_sbj"])
	     apply (simp only: split_suspendsj [symmetric] suspendsj)
	     apply simp
	     done

	   from valid_reads [OF j_bound'' tssb_j]
	   have reads_consis: "reads_consistent False 𝒪j msb sbj".

	   from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb j_bound''
	     tssb_j reads_consis]
	   have reads_consis_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
	     by (simp add: m suspendsj)

	   from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j tssb_i tssb_j]
	   have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
	     by (simp add: suspendsj)
	   from reads_consistent_flush_independent [OF this reads_consis_m]
	   have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	     ?m_A suspendsj".
	   hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  ?m_A ys"
	     by (simp add: split_suspendsj reads_consistent_append)


	   from valid_history [OF j_bound'' tssb_j]
	   have h_consis: 
	     "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
	     apply (simp only: split_suspendsj [symmetric] suspendsj)
	     apply simp
	     done

	   have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	   proof -
	     from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
	       by simp
	     from last_prog_hd_prog_append' [OF h_consis] this
	     have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
	       by (simp only: split_suspendsj [symmetric] suspendsj) 
	     moreover 
	     have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		  last_prog (hd_prog pj suspendsj) ?take_sbj"
	       apply (simp only: split_suspendsj [symmetric] suspendsj) 
	       by (rule last_prog_hd_prog_append)
	     ultimately show ?thesis
	       by (simp add: split_suspendsj [symmetric] suspendsj) 
	   qed

	   from valid_write_sops [OF j_bound'' tssb_j]
	   have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
	     by (simp add: split_suspendsj [symmetric] suspendsj)
	   then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
	     valid_sops_drop: "sopwrite_sops ys. valid_sop sop"
	     apply (simp only: write_sops_append )
	     apply auto
	     done

	   from read_tmps_distinct [OF j_bound'' tssb_j]
	   have "distinct_read_tmps (?take_sbj@suspendsj)"
	     by (simp add: split_suspendsj [symmetric] suspendsj)
	   then obtain 
	     read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
	     distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
	     apply (simp only: split_suspendsj [symmetric] suspendsj) 
	     apply (simp only: distinct_read_tmps_append)
	     done
	   
	   from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]	  
	     last_prog_hd_prog
	   have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
	     by (simp add: split_suspendsj [symmetric] suspendsj) 
	    from reads_consistent_drop_volatile_writes_no_volatile_reads  
	    [OF reads_consis] 
	    have no_vol_read: "outstanding_refs is_volatile_Readsb ys = {}"
	      by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )
	   
	    from flush_store_buffer_append [
	      OF j_bound''''  isj [simplified split_suspendsj] cph [simplified suspendsj]
	      ts_A_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_m_A_ys
	      hist_consis' [simplified split_suspendsj] valid_sops_drop distinct_read_tmps_drop [simplified split_suspendsj] 
	      no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="?share_A"]
	    obtain isj' j' where
	      isj': "instrs (Writesb True a' sop v A' L' R' W' # zs) @ issbj = 
	            isj' @ prog_instrs (Writesb True a' sop v A' L' R' W' # zs)" and
	      steps_ys: "(?ts_A, ?m_A, ?share_A)  d* 
		(?ts_A[j:= (last_prog (hd_prog pj (Writesb True a' sop v A' L' R' W' # zs)) ys,
                           isj',
                           θsbj |` (dom θsbj - read_tmps (Writesb True a' sop v A' L' R' W' # zs)),(),
                           𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j') ],
                  flush ys ?m_A,
                  share ys ?share_A)"
		 (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
              by (auto)

	    note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
	    from cph
	    have "causal_program_history issbj ((ys @ [Writesb True a' sop v A' L' R' W']) @ zs)"
	      by simp
	    from causal_program_history_suffix [OF this]
	    have cph': "causal_program_history issbj zs".	      
	    interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

	    from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
	    obtain isj''
	      where isj': "isj' = Write True a' sop A' L' R' W' #isj''" and
	      isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
	      by clarsimp

	    from j_bound'''
	    have j_bound_ys: "j < length ?ts_ys"
	      by auto

	    from j_bound_ys neq_i_j
	    have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog pj (Writesb True a' sop v A' L' R' W'# zs)) ys, isj',
                 θsbj |` (dom θsbj - read_tmps (Writesb True a' sop v A' L' R' W'# zs)),(),
                 𝒟j  outstanding_refs is_volatile_Writesb ys  {},
                 acquired True ys (acquired True ?take_sbj 𝒪j),j')"
	      by auto

	    from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	    have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	    from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified isj']
	    have a_unowned: 
		"i < length ?ts_ys. ji  (let (𝒪i) = map owned ?ts_ys!i in a'  𝒪i)"
	      apply cases
	      apply (auto simp add: Let_def issb)
	      done
	    from a'_in a_unowned [rule_format, of i] neq_i_j i_bound' A_R
	    show False
	      by (auto simp add: Let_def)
	  qed
	}
	thus ?thesis
	  by (auto simp add: Let_def)
      qed

      have A_unaquired_by_others:
	  "j<length (map 𝒪_sb tssb). i  j 
             (let (𝒪j, sbj) = map 𝒪_sb tssb! j
             in A  all_acquired sbj = {})"
      proof -
	{
	  fix j 𝒪j sbj
	  assume j_bound: "j < length (map owned tssb)"
	  assume neq_i_j: "ij"
	  assume tssb_j: "(map 𝒪_sb tssb)!j = (𝒪j,sbj)"
	  assume conflict: "A  all_acquired sbj  {}"
	  have False
	  proof -
	    from j_bound leq
	    have j_bound': "j < length (map owned ts)"
	      by auto
	    from j_bound have j_bound'': "j < length tssb"
	      by auto
	    from j_bound' have j_bound''': "j < length ts"
	      by simp
	    
	    from conflict obtain a' where
	      a'_in: "a'  A" and
              a'_in_j: "a'  all_acquired sbj"
	      by auto

	    let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	    let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"

	    from ts_sim [rule_format, OF  j_bound''] tssb_j j_bound''
	    obtain pj suspendsj "issbj" θsbj 𝒟sbj 𝒟j j "isj" where
	      tssb_j: "tssb ! j = (pj,issbj, θsbj, sbj,𝒟sbj,𝒪j,j)" and
	      suspendsj: "suspendsj = ?drop_sbj" and
	      𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
	      isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	      tsj: "ts!j = (hd_prog pj suspendsj, isj,
	                   θsbj |` (dom θsbj - read_tmps suspendsj),(), 
                           𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	      apply (cases "tssb!j")
	      apply (force simp add: Let_def)
	      done

	    from a'_in_j all_acquired_append [of ?take_sbj ?drop_sbj]
	    have "a'  all_acquired ?take_sbj  a'  all_acquired suspendsj"
	      by (auto simp add: suspendsj)
	    thus False
	    proof 
	      assume "a'  all_acquired ?take_sbj"
	      with A_unowned_by_others [rule_format, OF _ neq_i_j] tssb_j j_bound a'_in
	      show False
		by (auto dest: all_acquired_unshared_acquired)
	    next
	      assume conflict_drop: "a'  all_acquired suspendsj"
	      from split_all_acquired_in [OF conflict_drop]
	      (* FIXME: exract common parts *)
	      show False
	      proof 
		assume "sop a'' v ys zs A L R W. 
                         suspendsj = ys @ Writesb True a'' sop v A L R W# zs  a'  A" 
	        then
		obtain a'' sop' v' ys zs A' L' R' W' where
		  split_suspendsj: "suspendsj = ys @ Writesb True a'' sop' v' A' L' R' W' # zs" 
		    (is "suspendsj = ?suspends") and
		  a'_A': "a'  A'"
		 by auto
	    
	       from direct_memop_step.Ghost [where  θ=θsb and m="flush ?drop_sb m"]
	       have "(Ghost A L R W# issb', 
                         θsb, (), flush ?drop_sb m,𝒟sb, 
                         acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb,share ?drop_sb 𝒮)  
                    (issb', θsb, (), flush ?drop_sb m, 𝒟sb, 
                      acquired True sb 𝒪sb  A - R, 
                      augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮sb) sb),
                      share ?drop_sb 𝒮W RA L)".

	       from direct_computation.concurrent_step.Memop [OF 
		 i_bound_ts' [simplified issb] ts'_i [simplified issb] this [simplified issb]] 
	       have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) d 
                   (?ts'[i := (psb, issb',θsb, (),𝒟sb, 
                         acquired True sb 𝒪sb  A - R,
                         augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮sb) sb))], 
          
                         flush ?drop_sb m,share ?drop_sb 𝒮W RA L)"
		   (is " _ d (?ts_A, ?m_A, ?share_A)")
		 by (simp add: issb)
	      
	       
	       from i_bound' have i_bound'': "i < length ?ts_A"
		 by simp

	       from valid_program_history [OF j_bound'' tssb_j] 
	       have "causal_program_history issbj sbj".
	       then have cph: "causal_program_history issbj ?suspends"
		 apply -
		 apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply (simp add: split_suspendsj)
		 done
	       
	       from tsj neq_i_j j_bound 
	       have ts_A_j: "?ts_A!j = (hd_prog pj (ys @ Writesb True a'' sop' v' A' L' R' W' # zs), isj,
		   θsbj |` (dom θsbj - read_tmps (ys @ Writesb True a'' sop' v' A' L' R' W' # zs)), (), 𝒟j, 
		   acquired True ?take_sbj 𝒪j, release ?take_sbj (dom 𝒮sb) j)"
		 by (simp add: split_suspendsj)


	       from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
		 by simp

	       from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
	       then
	       have lp: "last_prog pj ?suspends = pj"
		 apply -
		 apply (rule last_prog_same_append [where sb="?take_sbj"])
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply simp
		 done
	       

	       from valid_reads [OF j_bound'' tssb_j]
	       have reads_consis: "reads_consistent False 𝒪j msb sbj".
	       
	       from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb j_bound''
		 tssb_j reads_consis]
	       have reads_consis_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		 by (simp add: m suspendsj)

	       from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j tssb_i tssb_j]
	       have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
		 by (simp add: suspendsj)
	       from reads_consistent_flush_independent [OF this reads_consis_m]
	       have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
		 ?m_A suspendsj".
	       hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  ?m_A ys"
		 by (simp add: split_suspendsj reads_consistent_append)       
	       
	       from valid_history [OF j_bound'' tssb_j]
	       have h_consis: 
		 "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply simp
		 done
	       
	       have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	       proof -
		 from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		   by simp
		 from last_prog_hd_prog_append' [OF h_consis] this
		 have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		   by (simp only: split_suspendsj [symmetric] suspendsj) 
		 moreover 
		 have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		   last_prog (hd_prog pj suspendsj) ?take_sbj"
		   apply (simp only: split_suspendsj [symmetric] suspendsj) 
		   by (rule last_prog_hd_prog_append)
		 ultimately show ?thesis
		   by (simp add: split_suspendsj [symmetric] suspendsj) 
	       qed
	       
	       from valid_write_sops [OF j_bound'' tssb_j]
	       have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		 by (simp add: split_suspendsj [symmetric] suspendsj)
	       then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		 valid_sops_drop: "sopwrite_sops ys. valid_sop sop"
		 apply (simp only: write_sops_append )
		 apply auto
		 done
	       
	       from read_tmps_distinct [OF j_bound'' tssb_j]
	       have "distinct_read_tmps (?take_sbj@suspendsj)"
		 by (simp add: split_suspendsj [symmetric] suspendsj)
	       then obtain 
		 read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
		 distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		 apply (simp only: split_suspendsj [symmetric] suspendsj) 
		 apply (simp only: distinct_read_tmps_append)
		 done
	       
	       from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]	  
		 last_prog_hd_prog
	       have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
		 by (simp add: split_suspendsj [symmetric] suspendsj) 
	       from reads_consistent_drop_volatile_writes_no_volatile_reads  
	       [OF reads_consis] 
	       have no_vol_read: "outstanding_refs is_volatile_Readsb ys = {}"
		 by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		   split_suspendsj )
	       
	       from flush_store_buffer_append [
		 OF j_bound''''  isj [simplified split_suspendsj] cph [simplified suspendsj]
		 ts_A_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_m_A_ys
		 hist_consis' [simplified split_suspendsj] valid_sops_drop distinct_read_tmps_drop [simplified split_suspendsj] 
		 no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
		 𝒮="?share_A"]
	       obtain isj' j' where
		 isj': "instrs (Writesb True a'' sop' v' A' L' R' W' # zs) @ issbj = 
	            isj' @ prog_instrs (Writesb True a'' sop' v' A' L' R' W' # zs)" and
		 steps_ys: "(?ts_A, ?m_A, ?share_A)  d* 
		(?ts_A[j:= (last_prog (hd_prog pj (Writesb True a'' sop' v' A' L' R' W' # zs)) ys,
                           isj',
                           θsbj |` (dom θsbj - read_tmps (Writesb True a'' sop' v' A' L' R' W' # zs)),(),
                           𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j') ],
                  flush ys ?m_A,share ys ?share_A)"
		 (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
		 by (auto)

	       note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
	       from cph
	       have "causal_program_history issbj ((ys @ [Writesb True a'' sop' v' A' L' R' W']) @ zs)"
		 by simp
	       from causal_program_history_suffix [OF this]
	       have cph': "causal_program_history issbj zs".	      
	       interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

	       from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
	       obtain isj''
		 where isj': "isj' = Write True a'' sop' A' L' R' W'#isj''" and
		 isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
		 by clarsimp
	       
	       from j_bound'''
	       have j_bound_ys: "j < length ?ts_ys"
		 by auto

	       from j_bound_ys neq_i_j
	       have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog pj (Writesb True a'' sop' v' A' L' R' W'# zs)) ys, isj',
                 θsbj |` (dom θsbj - read_tmps (Writesb True a'' sop' v' A' L' R' W'# zs)),(), 
		 𝒟j  outstanding_refs is_volatile_Writesb ys  {},
                 acquired True ys (acquired True ?take_sbj 𝒪j),j')"
		 by auto

	       from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	       have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	       from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified isj']
	       have A'_unowned: 
		 "i < length ?ts_ys. ji  (let (𝒪i) = map owned ?ts_ys!i in A'   𝒪i = {})"
		 apply cases
		 apply (fastforce simp add: Let_def issb)+
		 done
	       from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R 
	       show False
		 by (auto simp add: Let_def)
	     next
	       assume "A L R W ys zs. 
                 suspendsj = ys @ Ghostsb A L R W # zs  a'  A" 
	       then
	       obtain ys zs A' L' R' W' where
		  split_suspendsj: "suspendsj = ys @ Ghostsb A' L' R' W'# zs" (is "suspendsj = ?suspends") and
		 a'_A': "a'  A'"
		 by auto
		 
	       from direct_memop_step.Ghost [where  θ=θsb and m="flush ?drop_sb m"]
	       have "(Ghost A L R W# issb', 
                       θsb, (), flush ?drop_sb m, 𝒟sb, 
                       acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb, share ?drop_sb 𝒮)  
                    (issb', θsb, (), flush ?drop_sb m, 𝒟sb, 
                      acquired True sb 𝒪sb  A - R, 
                      augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮sb) sb),
                      share ?drop_sb 𝒮W RA L)".

	       from direct_computation.concurrent_step.Memop [OF 
		 i_bound_ts' [simplified issb] ts'_i [simplified issb] this [simplified issb]] 
	       have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) d 
                   (?ts'[i := (psb, issb', θsb, (), 𝒟sb, acquired True sb 𝒪sb  A - R,augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮sb) sb))], 
                         flush ?drop_sb m,share ?drop_sb 𝒮W RA L)"
		   (is " _ d (?ts_A, ?m_A, ?share_A)")
		 by (simp add: issb)
	      
	       
	       from i_bound' have i_bound'': "i < length ?ts_A"
		 by simp

	       from valid_program_history [OF j_bound'' tssb_j] 
	       have "causal_program_history issbj sbj".
	       then have cph: "causal_program_history issbj ?suspends"
		 apply -
		 apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply (simp add: split_suspendsj)
		 done
	       
	       from tsj neq_i_j j_bound 
	       have ts_A_j: "?ts_A!j = (hd_prog pj (ys @ Ghostsb A' L' R' W'# zs), isj,
		 θsbj |` (dom θsbj - read_tmps (ys @ Ghostsb A' L' R' W'# zs)), (),𝒟j, 
		 acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
		 by (simp add: split_suspendsj)


	       from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
		 by simp
	       
	       from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
	       then
	       have lp: "last_prog pj ?suspends = pj"
		 apply -
		 apply (rule last_prog_same_append [where sb="?take_sbj"])
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply simp
		 done
	       from valid_reads [OF j_bound'' tssb_j]
	       have reads_consis: "reads_consistent False 𝒪j msb sbj".
	       
	       from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb j_bound''
		 tssb_j reads_consis]
	       have reads_consis_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		 by (simp add: m suspendsj)

	       from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j tssb_i tssb_j]
	       have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
		 by (simp add: suspendsj)
	       from reads_consistent_flush_independent [OF this reads_consis_m]
	       have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
		 ?m_A suspendsj".
	       hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  ?m_A ys"
		 by (simp add: split_suspendsj reads_consistent_append)


	       from valid_history [OF j_bound'' tssb_j]
	       have h_consis: 
		 "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		 apply (simp only: split_suspendsj [symmetric] suspendsj)
		 apply simp
		 done
	       
	       have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	       proof -
		 from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		   by simp
		 from last_prog_hd_prog_append' [OF h_consis] this
		 have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		   by (simp only: split_suspendsj [symmetric] suspendsj) 
		 moreover 
		 have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		   last_prog (hd_prog pj suspendsj) ?take_sbj"
		   apply (simp only: split_suspendsj [symmetric] suspendsj) 
		   by (rule last_prog_hd_prog_append)
		 ultimately show ?thesis
		   by (simp add: split_suspendsj [symmetric] suspendsj) 
	       qed
	       
	       from valid_write_sops [OF j_bound'' tssb_j]
	       have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		 by (simp add: split_suspendsj [symmetric] suspendsj)
	       then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		   valid_sops_drop: "sopwrite_sops ys. valid_sop sop"
		 apply (simp only: write_sops_append )
		 apply auto
		 done
	       
	       from read_tmps_distinct [OF j_bound'' tssb_j]
	       have "distinct_read_tmps (?take_sbj@suspendsj)"
		 by (simp add: split_suspendsj [symmetric] suspendsj)
	       then obtain 
		 read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
		 distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		 apply (simp only: split_suspendsj [symmetric] suspendsj) 
		 apply (simp only: distinct_read_tmps_append)
		 done
	       
	       from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]	  
		 last_prog_hd_prog
	       have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
		 by (simp add: split_suspendsj [symmetric] suspendsj) 
	       from reads_consistent_drop_volatile_writes_no_volatile_reads  
	       [OF reads_consis] 
	       have no_vol_read: "outstanding_refs is_volatile_Readsb ys = {}"
		 by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		   split_suspendsj )
	   
	       from flush_store_buffer_append [
		 OF j_bound''''  isj [simplified split_suspendsj] cph [simplified suspendsj]
		 ts_A_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_m_A_ys
		 hist_consis' [simplified split_suspendsj] valid_sops_drop distinct_read_tmps_drop [simplified split_suspendsj] 
		 no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
		 𝒮="?share_A"]
	       obtain isj' j' where
		 isj': "instrs (Ghostsb A' L' R' W'# zs) @ issbj = 
	            isj' @ prog_instrs (Ghostsb A' L' R' W'# zs)" and
		 steps_ys: "(?ts_A, ?m_A, ?share_A)  d* 
		(?ts_A[j:= (last_prog (hd_prog pj (Ghostsb A' L' R' W'# zs)) ys,
                           isj',
                           θsbj |` (dom θsbj - read_tmps (Ghostsb A' L' R' W'# zs)),(),
		           𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j') ],
                  flush ys ?m_A,                  share ys ?share_A)"
		 (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
		 by (auto)

	       note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
	       from cph
	       have "causal_program_history issbj ((ys @ [Ghostsb A' L' R' W']) @ zs)"
		 by simp
	       from causal_program_history_suffix [OF this]
	       have cph': "causal_program_history issbj zs".	      
	       interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

	       from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
	       obtain isj''
		 where isj': "isj' = Ghost A' L' R' W'#isj''" and
		 isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
		 by clarsimp
	       
	       from j_bound'''
	       have j_bound_ys: "j < length ?ts_ys"
		 by auto

	       from j_bound_ys neq_i_j
	       have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog pj (Ghostsb A' L' R' W'# zs)) ys, isj',
                 θsbj |` (dom θsbj - read_tmps (Writesb True a'' sop' v' A' L' R' W'# zs)),(),
		 𝒟j  outstanding_refs is_volatile_Writesb ys  {},
                 acquired True ys (acquired True ?take_sbj 𝒪j),j')"
		 by auto

	       from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	       have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	       from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified isj']
	       have A'_unowned: 
		 "i < length ?ts_ys. ji  (let (𝒪i) = map owned ?ts_ys!i in A'   𝒪i = {})"
		 apply cases
		 apply (fastforce simp add: Let_def issb)+
		 done
	       from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R 
	       show False
		 by (auto simp add: Let_def)
	     qed
	   qed
	 qed
       }
       thus ?thesis
	 by (auto simp add: Let_def)
      qed

      have A_no_read_only_reads_by_others:
	  "j<length (map 𝒪_sb tssb). i  j 
             (let (𝒪j, sbj) = map 𝒪_sb tssb! j
             in A  read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j)
	             (dropWhile (Not  is_volatile_Writesb) sbj) = {})"
      proof -
	{
	  fix j 𝒪j sbj
	  assume j_bound: "j < length (map owned tssb)"
	  assume neq_i_j: "ij"
	  assume tssb_j: "(map 𝒪_sb tssb)!j = (𝒪j,sbj)"
	  let ?take_sbj = "(takeWhile (Not  is_volatile_Writesb) sbj)"
	  let ?drop_sbj = "(dropWhile (Not  is_volatile_Writesb) sbj)"

	  assume conflict: "A  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj   {}"
	  have False
	  proof -
	    from j_bound leq
	    have j_bound': "j < length (map owned ts)"
	      by auto
	    from j_bound have j_bound'': "j < length tssb"
	      by auto
	    from j_bound' have j_bound''': "j < length ts"
	      by simp
	    
	    from conflict obtain a' where
	      a'_in: "a'  A" and
              a'_in_j: "a'  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	      by auto


	    from ts_sim [rule_format, OF  j_bound''] tssb_j j_bound''
	    obtain pj suspendsj "issbj" 𝒟sbj 𝒟j j θsbj "isj" where
	      tssb_j: "tssb ! j = (pj,issbj, θsbj, sbj,𝒟sbj,𝒪j,j)" and
	      suspendsj: "suspendsj = ?drop_sbj" and
	      isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	      𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
	      tsj: "ts!j = (hd_prog pj suspendsj, isj,
	             θsbj |` (dom θsbj - read_tmps suspendsj),(), 𝒟j, acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	      apply (cases "tssb!j")
	      apply (force simp add: Let_def)
	      done
	      

	    from split_in_read_only_reads [OF a'_in_j [simplified suspendsj [symmetric]]]
	    obtain t v ys zs where
	      split_suspendsj: "suspendsj = ys @ Readsb False a' t v# zs" (is "suspendsj = ?suspends") and
	      a'_unacq: "a'  acquired True ys (acquired True ?take_sbj 𝒪j)"
	      by blast

	    
	    from direct_memop_step.Ghost [where  θ=θsb and m="flush ?drop_sb m"]
	    have "(Ghost A L R W# issb', 
                       θsb, (), flush ?drop_sb m, 𝒟sb, 
                       acquired True sb 𝒪sb, release sb (dom 𝒮sb) sb, share ?drop_sb 𝒮)  
                    (issb', θsb, (), flush ?drop_sb m, 𝒟sb, 
                      acquired True sb 𝒪sb  A - R, 
                      augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮sb) sb),
                      share ?drop_sb 𝒮W RA L)".

	    from direct_computation.concurrent_step.Memop [OF 
		 i_bound_ts' [simplified issb] ts'_i [simplified issb] this [simplified issb]] 
	    have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) d 
                    (?ts'[i := (psb, issb', θsb, (),𝒟sb, acquired True sb 𝒪sb  A - R,augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮sb) sb))], 
                         flush ?drop_sb m,share ?drop_sb 𝒮W RA L)"
		  (is " _ d (?ts_A, ?m_A, ?share_A)")
	     by (simp add: issb)
	    
	    from i_bound' have i_bound'': "i < length ?ts_A"
	      by simp

	    from valid_program_history [OF j_bound'' tssb_j] 
	    have "causal_program_history issbj sbj".
	    then have cph: "causal_program_history issbj ?suspends"
	      apply -
	      apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply (simp add: split_suspendsj)
	      done
	       
	    from tsj neq_i_j j_bound 
	    have ts_A_j: "?ts_A!j = (hd_prog pj (ys @ Readsb False a' t v# zs), isj,
	      θsbj |` (dom θsbj - read_tmps (ys @ Readsb False a' t v# zs)), (),𝒟j, 
	      acquired True ?take_sbj 𝒪j,release ?take_sbj (dom 𝒮sb) j)"
	      by (simp add: split_suspendsj)
	    

	    from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
	      by simp
	       
	    from valid_last_prog [OF j_bound'' tssb_j] have last_prog: "last_prog pj sbj = pj".
	    then
	    have lp: "last_prog pj ?suspends = pj"
	      apply -
	      apply (rule last_prog_same_append [where sb="?take_sbj"])
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	    from valid_reads [OF j_bound'' tssb_j]
	    have reads_consis: "reads_consistent False 𝒪j msb sbj".
	    
	    from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb j_bound''
		 tssb_j reads_consis]
	    have reads_consis_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
	      by (simp add: m suspendsj)
	    
	    from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j tssb_i tssb_j]
	    have "outstanding_refs is_Writesb ?drop_sb  outstanding_refs is_non_volatile_Readsb suspendsj = {}"
	      by (simp add: suspendsj)
	    from reads_consistent_flush_independent [OF this reads_consis_m]
	    have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sbj 𝒪j) 
	      ?m_A suspendsj".
	    hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  ?m_A ys"
	      by (simp add: split_suspendsj reads_consistent_append)
	    

	    from valid_history [OF j_bound'' tssb_j]
	    have h_consis: 
	      "history_consistent θsbj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
	      apply (simp only: split_suspendsj [symmetric] suspendsj)
	      apply simp
	      done
	       
	    have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	    proof -
	      from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		by simp
	      from last_prog_hd_prog_append' [OF h_consis] this
	      have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		by (simp only: split_suspendsj [symmetric] suspendsj) 
	      moreover 
	      have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		last_prog (hd_prog pj suspendsj) ?take_sbj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		by (rule last_prog_hd_prog_append)
	      ultimately show ?thesis
		by (simp add: split_suspendsj [symmetric] suspendsj) 
	    qed
	    
	    from valid_write_sops [OF j_bound'' tssb_j]
	    have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		   valid_sops_drop: "sopwrite_sops ys. valid_sop sop"
	      apply (simp only: write_sops_append )
	      apply auto
	      done
	    
	    from read_tmps_distinct [OF j_bound'' tssb_j]
	    have "distinct_read_tmps (?take_sbj@suspendsj)"
	      by (simp add: split_suspendsj [symmetric] suspendsj)
	    then obtain 
		 read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
	      distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
	      apply (simp only: split_suspendsj [symmetric] suspendsj) 
	      apply (simp only: distinct_read_tmps_append)
	      done
	       
	    from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]	  
	      last_prog_hd_prog
	    have hist_consis': "history_consistent θsbj (hd_prog pj suspendsj) suspendsj"
	      by (simp add: split_suspendsj [symmetric] suspendsj) 
	    from reads_consistent_drop_volatile_writes_no_volatile_reads  
	    [OF reads_consis] 
	    have no_vol_read: "outstanding_refs is_volatile_Readsb ys = {}"
	      by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )
	   
	    from flush_store_buffer_append [
		 OF j_bound''''  isj [simplified split_suspendsj] cph [simplified suspendsj]
		 ts_A_j [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_m_A_ys
		 hist_consis' [simplified split_suspendsj] valid_sops_drop distinct_read_tmps_drop [simplified split_suspendsj] 
		 no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
		 𝒮="?share_A"]
	    obtain isj' j' where
		 isj': "instrs (Readsb False a' t v # zs) @ issbj = 
	            isj' @ prog_instrs (Readsb False a' t v # zs)" and
		 steps_ys: "(?ts_A, ?m_A, ?share_A)  d* 
		(?ts_A[j:= (last_prog (hd_prog pj (Ghostsb A' L' R' W'# zs)) ys,
                           isj',
                           θsbj |` (dom θsbj - read_tmps (Readsb False a' t v # zs)),(),
		           𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j),j') ],
                  flush ys ?m_A,
                  share ys ?share_A)"
	      (is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
	      by (auto)
	    
	    note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]

	    from cph
	    have "causal_program_history issbj ((ys @ [Readsb False a' t v]) @ zs)"
	      by simp
	    from causal_program_history_suffix [OF this]
	    have cph': "causal_program_history issbj zs".	      
	    interpret causalj: causal_program_history "issbj" "zs" by (rule cph')

	    from causalj.causal_program_history [of "[]", simplified, OF refl] isj'   
	    obtain isj''
	      where isj': "isj' = Read False a' t#isj''" and
	      isj'': "instrs zs @ issbj = isj'' @ prog_instrs zs"
	      by clarsimp

	    from j_bound'''
	    have j_bound_ys: "j < length ?ts_ys"
	      by auto

	    from j_bound_ys neq_i_j
	    have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog pj (Readsb False a' t v# zs)) ys, isj',
                 θsbj |` (dom θsbj - read_tmps (Readsb False a' t v# zs)),(),
	         𝒟j  outstanding_refs is_volatile_Writesb ys  {},
                 acquired True ys (acquired True ?take_sbj 𝒪j),j')"
	      by auto

	    from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	    have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	    
	    from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified isj']
	    have "a'  acquired True ys (acquired True ?take_sbj 𝒪j) 
                  a'  read_only (share ys (share ?drop_sb 𝒮W RA L))"
	      apply cases
	      apply (auto simp add: Let_def issb)
	      done
	    with a'_unacq
	    have a'_ro: "a'  read_only (share ys (share ?drop_sb 𝒮W RA L))"
	      by auto
	    from a'_in
	    have a'_not_ro: "a'  read_only (share ?drop_sb 𝒮W RA L)"
	      by (auto simp add:  in_read_only_convs)

	    have "a'  𝒪j  all_acquired sbj"
	    proof -
	      {
		assume a_notin: "a'  𝒪j  all_acquired sbj"
		from weak_sharing_consis [OF j_bound'' tssb_j]
		have "weak_sharing_consistent 𝒪j sbj".
		with weak_sharing_consistent_append [of 𝒪j ?take_sbj ?drop_sbj]
		have "weak_sharing_consistent (acquired True ?take_sbj 𝒪j) suspendsj"
		  by (auto simp add: suspendsj)
		with split_suspendsj
		have weak_consis: "weak_sharing_consistent (acquired True ?take_sbj 𝒪j) ys"
		  by (simp add: weak_sharing_consistent_append)
		from all_acquired_append [of ?take_sbj ?drop_sbj]
		have "all_acquired ys  all_acquired sbj"
		  apply (clarsimp)
		  apply (clarsimp simp add: suspendsj [symmetric] split_suspendsj all_acquired_append)
		  done
		with a_notin acquired_takeWhile_non_volatile_Writesb [of sbj 𝒪j]
                  all_acquired_append [of ?take_sbj ?drop_sbj]
		have "a'  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j  all_acquired ys"
                  by auto
                
		from read_only_share_unowned [OF weak_consis this a'_ro] 
		have "a'  read_only (share ?drop_sb 𝒮W RA L)" .
		  
		with a'_not_ro have False
		  by auto
	      }
	      thus ?thesis by blast
	    qed
		
	    moreover
	    from A_unaquired_by_others [rule_format, OF _ neq_i_j] tssb_j j_bound
	    have "A  all_acquired sbj = {}"
	      by (auto simp add: Let_def)
	    moreover
	    from A_unowned_by_others [rule_format, OF _ neq_i_j] tssb_j j_bound
	    have "A  𝒪j = {}"
	      by (auto simp add: Let_def dest: all_shared_acquired_in)
	    moreover note a'_in
	    ultimately
	    show False
	      by auto
	  qed
	}
	thus ?thesis
	  by (auto simp add: Let_def)
      qed

      have valid_own': "valid_ownership 𝒮sb' tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	proof -
	  from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i] 
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb (sb @ [Ghostsb A L R W]) "
	    by (auto simp add: non_volatile_owned_or_read_only_append)
	  from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	  show ?thesis by (simp add: tssb' sb' 𝒪sb' 𝒮sb')
	qed
      next
	show "outstanding_volatile_writes_unowned_by_others tssb'"
	proof (unfold_locales)
	  fix i1 j p1 "is1" 𝒪1 1 𝒟1 xs1 sb1 pj "isj" "𝒪j" j 𝒟j xsj sbj
	  assume i1_bound: "i1 < length tssb'"
	  assume j_bound: "j < length tssb'"
	  assume i1_j: "i1  j"
	  assume ts_i1: "tssb'!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	  assume ts_j: "tssb'!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb1 = {}"
	  proof (cases "i1=i")
	    case True
	    with i1_j have i_j: "ij" 
	      by simp
	    
	    from j_bound have j_bound': "j < length tssb"
	      by (simp add: tssb')
	    hence j_bound'': "j < length (map owned tssb)"
	      by simp
	    from ts_j i_j have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (simp add: tssb')

	    from outstanding_volatile_writes_unowned_by_others 
	    [OF i_bound j_bound' i_j tssb_i ts_j']
	    have "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb = {}".
	    with ts_i1 True i_bound show ?thesis
	      by (clarsimp simp add: tssb' sb' outstanding_refs_append 
		acquired_takeWhile_non_volatile_Writesb)
	  next
	    case False
	    note i1_i = this
	    from i1_bound have i1_bound': "i1 < length tssb"
	      by (simp add: tssb')
	    from ts_i1 False have ts_i1': "tssb!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	      by (simp add: tssb')
	    show ?thesis
	    proof (cases "j=i")
	      case True

	      from i1_bound'
	      have i1_bound'': "i1 < length (map owned tssb)"
		by simp

	      from outstanding_volatile_writes_unowned_by_others 
	      [OF i1_bound' i_bound i1_i ts_i1' tssb_i]
	      have "(𝒪sb  all_acquired sb)  outstanding_refs is_volatile_Writesb sb1 = {}".
	      moreover
	      from A_unused_by_others [rule_format, OF _ False [symmetric]] False ts_i1 i1_bound
	      have "A  outstanding_refs is_volatile_Writesb sb1 = {}"
		by (auto simp add: Let_def tssb')
	      
	      ultimately
	      show ?thesis
		using ts_j True tssb' 
		by (auto simp add: i_bound tssb' 𝒪sb' sb' all_acquired_append)
	    next
	      case False
	      from j_bound have j_bound': "j < length tssb"
		by (simp add: tssb')
	      from ts_j False have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (simp add: tssb')
	      from outstanding_volatile_writes_unowned_by_others 
              [OF i1_bound' j_bound' i1_j ts_i1' ts_j']
	      show "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb1 = {}" .
	    qed
	  qed
	qed
      next
	show "read_only_reads_unowned tssb'"
	proof 
	  fix n m
	  fix pn "isn" 𝒪n n 𝒟n θn sbn pm "ism" 𝒪m m 𝒟m θm sbm
	  assume n_bound: "n < length tssb'"
	    and m_bound: "m < length tssb'"
	    and neq_n_m: "nm"
	    and nth: "tssb'!n = (pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
	    and mth: "tssb'!m =(pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
	  from n_bound have n_bound': "n < length tssb" by (simp add: tssb')
	  from m_bound have m_bound': "m < length tssb" by (simp add: tssb')
	  show "(𝒪m  all_acquired sbm) 
            read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbn) 𝒪n)
            (dropWhile (Not  is_volatile_Writesb) sbn) =
            {}"
	  proof (cases "m=i")
	    case True
	    with neq_n_m have neq_n_i: "ni"
	      by auto
	    with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
	      by (auto simp add: tssb')
	    note read_only_reads_unowned [OF n_bound' i_bound  neq_n_i nth' tssb_i]
	    moreover
	    from A_no_read_only_reads_by_others [rule_format, OF _ neq_n_i [symmetric]] n_bound' nth'
	    have "A  read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbn) 𝒪n)
              (dropWhile (Not  is_volatile_Writesb) sbn) =
              {}"
	      by auto
	    ultimately 
	    show ?thesis
	      using True tssb_i nth' mth n_bound' m_bound'
	      by (auto simp add: tssb' 𝒪sb' sb' all_acquired_append)
	  next
	    case False
	    note neq_m_i = this
	    with m_bound mth i_bound have mth': "tssb!m = (pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
	      by (auto simp add: tssb')
	    show ?thesis
	    proof (cases "n=i")
	      case True
	      note read_only_reads_unowned [OF i_bound m_bound' neq_m_i [symmetric] tssb_i mth']
	      then show ?thesis
		using True neq_m_i tssb_i nth mth n_bound' m_bound'
		apply (case_tac "outstanding_refs (is_volatile_Writesb) sb = {}")
		apply (clarsimp simp add: outstanding_vol_write_take_drop_appends
		  acquired_append read_only_reads_append tssb' sb' 𝒪sb')+
		done
	    next
	      case False
	      with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
		by (auto simp add: tssb')
	      from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m  nth' mth'] False neq_m_i
	      show ?thesis 
		by (clarsimp)
	    qed
	  qed
	qed
      next
	show "ownership_distinct tssb'"
	proof -
	  have "j<length tssb. i  j 
	    (let (pj, isj,θj, sbj, 𝒟j, 𝒪j,j) = tssb ! j
	      in (𝒪sb  all_acquired sb')  (𝒪j  all_acquired sbj) = {})"
	  proof -
	    {
	      fix j pj isj 𝒪j j 𝒟j θj sbj
	      assume neq_i_j: "i  j"
	      assume j_bound: "j < length tssb"
	      assume tssb_j: "tssb ! j = (pj, isj, θj, sbj, 𝒟j, 𝒪j,j)"
	      have "(𝒪sb  all_acquired sb')  (𝒪j  all_acquired sbj) = {}"
	      proof -
		{
		  fix a'
		  assume a'_in_i: "a'  (𝒪sb  all_acquired sb')"
		  assume a'_in_j: "a'  (𝒪j  all_acquired sbj)"
		  have False
		  proof -
		    from a'_in_i have "a'  (𝒪sb  all_acquired sb)  a'  A"
		      by (simp add: sb' all_acquired_append)
		    then show False
		    proof 
		      assume "a'  (𝒪sb  all_acquired sb)"
		      with ownership_distinct [OF i_bound j_bound neq_i_j tssb_i tssb_j] a'_in_j
		      show ?thesis
			by auto
		    next
		      assume "a'  A"
		      moreover
		      have j_bound': "j < length (map owned tssb)"
			using j_bound by auto
		      from A_unowned_by_others [rule_format, OF _ neq_i_j] tssb_j j_bound
		      obtain "A  acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j = {}" and
                             "A  all_shared (takeWhile (Not  is_volatile_Writesb) sbj) = {}"
			by (auto simp add: Let_def)
		      moreover
		      from A_unaquired_by_others [rule_format, OF _ neq_i_j] tssb_j j_bound
		      have "A  all_acquired sbj = {}"
			by auto
		      ultimately
		      show ?thesis
			using a'_in_j
			by (auto dest: all_shared_acquired_in)
		    qed
		  qed
		}
		then show ?thesis by auto
	      qed
	    }
	    then show ?thesis by (fastforce simp add: Let_def)
	  qed
	
	  from ownership_distinct_nth_update [OF i_bound tssb_i this]
	  show ?thesis by (simp add: tssb' 𝒪sb' sb')
	qed
      qed

      have valid_hist': "valid_history program_step tssb'"
      proof -
	from valid_history [OF i_bound tssb_i]
	have "history_consistent θsb (hd_prog psb sb) sb".
	with valid_write_sops [OF i_bound tssb_i] 
	  valid_implies_valid_prog_hd [OF i_bound tssb_i valid]
	have "history_consistent θsb (hd_prog psb (sb@[Ghostsb A L R W])) 
	         (sb@ [Ghostsb A L R W])"
	  apply -
	  apply (rule history_consistent_appendI)
	  apply (auto simp add: hd_prog_append_Ghostsb)
	  done
	from valid_history_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' θsb')
      qed

      have valid_reads': "valid_reads msb tssb'"
      proof -
	from valid_reads [OF i_bound tssb_i]
	have "reads_consistent False 𝒪sb msb sb" .
	from reads_consistent_snoc_Ghostsb [OF this]
	have "reads_consistent False 𝒪sb msb (sb @ [Ghostsb A L R W])".
	from valid_reads_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' sb' 𝒪sb') 
      qed

      have valid_sharing': "valid_sharing 𝒮sb' tssb'"
      proof (intro_locales)	
	from outstanding_non_volatile_writes_unshared [OF i_bound tssb_i] 
	have "non_volatile_writes_unshared 𝒮sb (sb @ [Ghostsb A L R W])"
	  by (auto simp add: non_volatile_writes_unshared_append)
	from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
	show "outstanding_non_volatile_writes_unshared 𝒮sb' tssb'"
	  by (simp add: tssb' sb' 𝒮sb')
      next
	from sharing_consis [OF i_bound tssb_i]
	have consis': "sharing_consistent 𝒮sb 𝒪sb sb".
	from  A_shared_owned
	have "A  dom (share ?drop_sb 𝒮)  acquired True sb 𝒪sb"
	  by (simp add:  sharing_consistent_append  acquired_takeWhile_non_volatile_Writesb)
	moreover have "dom (share ?drop_sb 𝒮)  dom 𝒮  dom (share sb 𝒮sb)"
	proof
	  fix a'
	  assume a'_in: "a'  dom (share ?drop_sb 𝒮)" 
	  from share_unshared_in [OF a'_in]
	  show "a'  dom 𝒮  dom (share sb 𝒮sb)"
	  proof 
	    assume "a'  dom (share ?drop_sb Map.empty)" 
	    from share_mono_in [OF this] share_append [of ?take_sb ?drop_sb]
	    have "a'  dom (share sb 𝒮sb)"
	      by auto
	    thus ?thesis
	      by simp
	  next
	    assume "a'  dom 𝒮  a'  all_unshared ?drop_sb"
	    thus ?thesis by auto
	  qed
	qed
	ultimately
	have A_subset: "A  dom 𝒮  dom (share sb 𝒮sb)  acquired True sb 𝒪sb"
	  by auto
        have "A  dom (share sb 𝒮sb)  acquired True sb 𝒪sb"
        proof -
          {
            fix x
            assume x_A: "x  A"
            have "x  dom (share sb 𝒮sb)  acquired True sb 𝒪sb"
            proof -
              {
                assume "x  dom 𝒮"
                
                from share_all_until_volatile_write_share_acquired [OF ‹sharing_consis 𝒮sb tssb 
                  i_bound tssb_i this [simplified 𝒮]]
                  A_unowned_by_others x_A
                have ?thesis
                by (fastforce simp add: Let_def)
             }
             with A_subset show ?thesis using x_A by auto
           qed
         }
         thus ?thesis by blast
        qed
	with consis' L_subset A_R R_acq
	have "sharing_consistent 𝒮sb 𝒪sb (sb @ [Ghostsb A L R W])"
	  by (simp add:  sharing_consistent_append  acquired_takeWhile_non_volatile_Writesb)
	from sharing_consis_nth_update [OF i_bound this]
	show "sharing_consis 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒪sb' sb' 𝒮sb')

      next
	from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound tssb_i] ]
	show "read_only_unowned 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' 𝒪sb')
      next
	from unowned_shared_nth_update [OF i_bound tssb_i subset_refl]
	show "unowned_shared 𝒮sb' tssb'"
	  by (simp add: tssb' sb' 𝒪sb' 𝒮sb')
      next
	from no_outstanding_write_to_read_only_memory [OF i_bound tssb_i] 
	have "no_write_to_read_only_memory 𝒮sb (sb @ [Ghostsb A L R W])"
	  by (simp add: no_write_to_read_only_memory_append)

	from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
	show "no_outstanding_write_to_read_only_memory 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' sb')
      qed

      have tmps_distinct': "tmps_distinct tssb'"
      proof (intro_locales)
	from load_tmps_distinct [OF i_bound tssb_i]
	have "distinct_load_tmps issb'" by (simp add: "issb")
	from load_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_distinct tssb'" by (simp add: tssb')
      next
	from read_tmps_distinct [OF i_bound tssb_i]
	have "distinct_read_tmps (sb @ [Ghostsb A L R W])"
	  by (auto simp add: distinct_read_tmps_append)
	from read_tmps_distinct_nth_update [OF i_bound this]
	show "read_tmps_distinct tssb'" by (simp add: tssb' sb')
      next
	from load_tmps_read_tmps_distinct [OF i_bound tssb_i]
	have "load_tmps issb'  read_tmps (sb @ [Ghostsb A L R W]) ={}"
	  by (auto simp add: read_tmps_append "issb")
	from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
	show "load_tmps_read_tmps_distinct tssb'" by (simp add: tssb' sb')
      qed
      
      have valid_sops': "valid_sops tssb'"
      proof -
	from valid_store_sops [OF i_bound tssb_i]
	obtain 
	  valid_store_sops': "sopstore_sops issb'. valid_sop sop"
	  by (auto simp add: "issb")
	from valid_write_sops [OF i_bound tssb_i]
	have valid_write_sops': "sopwrite_sops (sb@ [Ghostsb A L R W]). 
	  valid_sop sop"
	  by (auto simp add: write_sops_append)
	from valid_sops_nth_update [OF i_bound  valid_write_sops' valid_store_sops']
	show ?thesis by (simp add: tssb' sb')
      qed

      have valid_dd': "valid_data_dependency tssb'"
      proof -
	from data_dependency_consistent_instrs [OF i_bound tssb_i]
	obtain 
	  dd_is: "data_dependency_consistent_instrs (dom θsb') issb'"
	  by (auto simp add: "issb" θsb')
	from load_tmps_write_tmps_distinct [OF i_bound tssb_i] 
	have "load_tmps issb'  (fst ` write_sops (sb@ [Ghostsb A L R W])) ={}"
	  by (auto simp add: write_sops_append "issb")
	from valid_data_dependency_nth_update [OF i_bound dd_is this]
	show ?thesis by (simp add: tssb' sb')
      qed

      have load_tmps_fresh': "load_tmps_fresh tssb'"
      proof -
	from load_tmps_fresh [OF i_bound tssb_i] 
	have "load_tmps issb'  dom θsb = {}"
	  by (auto simp add: "issb")
	from load_tmps_fresh_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' θsb')
      qed

      have enough_flushs': "enough_flushs tssb'"
      proof -
	from clean_no_outstanding_volatile_Writesb [OF i_bound tssb_i]
	have "¬ 𝒟sb  outstanding_refs is_volatile_Writesb (sb@[Ghostsb A L R W])= {}"
	  by (auto simp add: outstanding_refs_append)
	from enough_flushs_nth_update [OF i_bound this]
	show ?thesis
	  by (simp add: tssb' sb' 𝒟sb')
      qed
	

      have valid_program_history': "valid_program_history tssb'"
      proof -	
	from valid_program_history [OF i_bound tssb_i]
	have "causal_program_history issb sb" .
	then have causal': "causal_program_history issb' (sb@[Ghostsb A L R W])"
	  by (auto simp: causal_program_history_Ghost  "issb")
	from valid_last_prog [OF i_bound tssb_i]
	have "last_prog psb sb = psb".
	hence "last_prog psb (sb @ [Ghostsb A L R W]) = psb"
	  by (simp add: last_prog_append_Ghostsb)
	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb' sb')
      qed

      show ?thesis
      proof (cases "outstanding_refs is_volatile_Writesb sb = {}")
	case True

	from True have flush_all: "takeWhile (Not  is_volatile_Writesb) sb = sb"
	  by (auto simp add: outstanding_refs_conv)
	
	from True have suspend_nothing: "dropWhile (Not  is_volatile_Writesb) sb = []"
	  by (auto simp add: outstanding_refs_conv)

	hence suspends_empty: "suspends = []"
	  by (simp add: suspends)

	from suspends_empty is_sim have "is": "is =Ghost A L R W# issb'"
	  by (simp add: "issb")

	with suspends_empty ts_i 
	have ts_i: "ts!i = (psb, Ghost A L R W# issb',
	  θsb,(), 𝒟, acquired True ?take_sb 𝒪sb,release ?take_sb (dom 𝒮sb) sb)"
	  by simp

	from direct_memop_step.Ghost 	
	have "(Ghost A L R W# issb', 
	  θsb, (),m, 𝒟, acquired True ?take_sb 𝒪sb, 
               release ?take_sb (dom 𝒮sb) sb, 𝒮)  
               (issb', 
	  θsb, (), m, 𝒟, acquired True ?take_sb 𝒪sb  A - R, 
           augment_rels (dom 𝒮) R (release ?take_sb (dom 𝒮sb) sb),
           𝒮W RA L)".
	from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
	have "(ts, m, 𝒮) d 
              (ts[i := (psb, issb', 
	          θsb, (),𝒟, acquired True ?take_sb 𝒪sb  A - R,
                  augment_rels (dom 𝒮) R (release ?take_sb (dom 𝒮sb) sb))], 
	       m,𝒮W RA L)".

	moreover

	from suspend_nothing
	have suspend_nothing': "(dropWhile (Not  is_volatile_Writesb) sb') = []"
	  by (simp add: sb')


	have all_shared_A: "j p is 𝒪  𝒟 θ sb. j < length tssb  i  j 
	  tssb ! j = (p, is, θ, sb, 𝒟, 𝒪,) 
	  all_shared (takeWhile (Not  is_volatile_Writesb) sb)  A = {}"
	proof -
	  {
	    fix j pj isj 𝒪j j 𝒟j θj sbj x
	    assume j_bound: "j < length tssb"
	    assume neq_i_j: "i  j"
	    assume jth: "tssb!j = (pj,isj, θj,sbj,𝒟j,𝒪j,j)"
	    assume x_shared: "x  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)"
	    assume x_A: "x  A"
	    have False
	    proof -
	      from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
	      have "all_shared sbj  all_acquired sbj  𝒪j".

	      moreover have "all_shared (takeWhile (Not  is_volatile_Writesb) sbj)  all_shared sbj"
		using all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
		  "(dropWhile (Not  is_volatile_Writesb) sbj)"]
		by auto
	      moreover

	      from A_unaquired_by_others [rule_format, OF _ neq_i_j] jth j_bound
	      have "A  all_acquired sbj = {}" by auto
	      moreover

	      from A_unowned_by_others [rule_format, OF _ neq_i_j] jth j_bound
	      have "A  𝒪j = {}"
		by (auto dest: all_shared_acquired_in)


	      ultimately
	      show False
		using x_A x_shared
		by blast
	    qed
	  }
	  thus ?thesis by blast
	qed

	hence all_shared_L: "j p is 𝒪  𝒟 θ sb. j < length tssb  i  j 
	  tssb ! j = (p, is, θ, sb, 𝒟, 𝒪,) 
	  all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {}"
	  using L_subset by blast

        have all_shared_A: "j p is 𝒪  𝒟 θ sb. j < length tssb  i  j 
            tssb ! j = (p, is, θ, sb, 𝒟, 𝒪,) 
            all_shared (takeWhile (Not  is_volatile_Writesb) sb)  A = {}"
        proof -
	  {
	    fix j pj isj 𝒪j j 𝒟j θj sbj x
	    assume j_bound: "j < length tssb"
	    assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
            assume neq_i_j: "i  j" 
	    assume x_shared: "x  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)"
	    assume x_A: "x  A"
	    have False
	    proof -
	      from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
	      have "all_shared sbj  all_acquired sbj  𝒪j".

	      moreover have "all_shared (takeWhile (Not  is_volatile_Writesb) sbj)  all_shared sbj"
		using all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
		  "(dropWhile (Not  is_volatile_Writesb) sbj)"]
		by auto
	      moreover
	      from A_unaquired_by_others [rule_format, OF _ neq_i_j] jth j_bound
	      have "A  all_acquired sbj = {}" by auto
	      moreover

	      from A_unowned_by_others [rule_format, OF _ neq_i_j] jth j_bound
	      have "A  𝒪j = {}"
	        by (auto dest: all_shared_acquired_in)


	      ultimately
	      show False
		using x_A x_shared 
		by blast
	    qed  
	  }
	  thus ?thesis by blast
        qed
        hence all_shared_L: "j p is 𝒪  𝒟 θ sb. j < length tssb  i  j 
            tssb ! j = (p, is, θ, sb, 𝒟, 𝒪,) 
            all_shared (takeWhile (Not  is_volatile_Writesb) sb)  L = {}"
	  using L_subset by blast

        have all_unshared_R: "j p is 𝒪  𝒟 θ sb. j < length tssb  i  j 
            tssb ! j = (p, is, θ, sb, 𝒟, 𝒪,) 
            all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}"
        proof -
	  {
	    fix j pj isj 𝒪j j 𝒟j θj sbj x
	    assume j_bound: "j < length tssb"
            assume neq_i_j: "i  j"
	    assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	    assume x_unshared: "x  all_unshared (takeWhile (Not  is_volatile_Writesb) sbj)"
	    assume x_R: "x  R"
	    have False
	    proof -
	      from unshared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
	      have "all_unshared sbj  all_acquired sbj  𝒪j".

	      moreover have "all_unshared (takeWhile (Not  is_volatile_Writesb) sbj)  all_unshared sbj"
		using all_unshared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
		  "(dropWhile (Not  is_volatile_Writesb) sbj)"]
		by auto
	      moreover

	      note ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth]

	      ultimately
	      show False
		using  R_acq x_R x_unshared acquired_all_acquired [of True sb 𝒪sb]
                by blast
	    qed
	  }
	  thus ?thesis by blast
        qed

        have all_acquired_R: "j p is 𝒪  𝒟 θ sb. j < length tssb  i  j 
            tssb ! j = (p, is, θ, sb, 𝒟, 𝒪,) 
            all_acquired (takeWhile (Not  is_volatile_Writesb) sb)  R = {}"
        proof -
	  {
	    fix j pj isj 𝒪j j 𝒟j θj sbj x
	    assume j_bound: "j < length tssb"
	    assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
            assume neq_i_j: "i  j" 
	    assume x_acq: "x  all_acquired (takeWhile (Not  is_volatile_Writesb) sbj)"
	    assume x_R: "x  R"
            have False
	    proof -

	      from x_acq have "x  all_acquired sbj"
		using all_acquired_append [of "takeWhile (Not  is_volatile_Writesb) sbj" 
		  "dropWhile (Not  is_volatile_Writesb) sbj"]
		by auto
	      moreover
	      note ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth]
	      ultimately
	      show False
		using  R_acq x_R acquired_all_acquired [of True sb 𝒪sb]
		by blast
	    qed
	  }
	  thus ?thesis by blast
        qed

        have all_shared_R: "j p is 𝒪  𝒟 θ sb. j < length tssb  i  j  
            tssb ! j = (p, is, θ, sb, 𝒟, 𝒪,) 
            all_shared (takeWhile (Not  is_volatile_Writesb) sb)  R = {}"
        proof -
	  {
	    fix j pj isj 𝒪j j 𝒟j θj sbj x
	    assume j_bound: "j < length tssb"
	    assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
            assume neq_i_j: "i  j" 
	    assume x_shared: "x  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)"
	    assume x_R: "x  R"
	    have False
	    proof -
	      from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
	      have "all_shared sbj  all_acquired sbj  𝒪j".

	      moreover have "all_shared (takeWhile (Not  is_volatile_Writesb) sbj)  all_shared sbj"
		using all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
		  "(dropWhile (Not  is_volatile_Writesb) sbj)"]
		by auto
	      moreover
	      note ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth]
	      ultimately 
	      show False
		using R_acq x_R x_shared acquired_all_acquired [of True sb 𝒪sb]
		by blast
	    qed
	  }
	  thus ?thesis by blast
        qed

	note share_commute = 
	  share_all_until_volatile_write_append_Ghostsb [OF True ‹ownership_distinct tssb ‹sharing_consis 𝒮sb tssb
	  i_bound tssb_i all_shared_L all_shared_A all_acquired_R all_unshared_R all_shared_R]
        
	from 𝒟
	have 𝒟': "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb (sb@[Ghostsb A L R W])   {})"
	  by (auto simp: outstanding_refs_append)


        have "a  R. (a  (dom (share sb 𝒮sb)) ) = (a  dom 𝒮)"
        proof -
          {
            fix a
            assume a_R: "a  R"
            have "(a  (dom (share sb 𝒮sb)) ) = (a  dom 𝒮)"
            proof -
              from a_R R_acq acquired_all_acquired [of True sb 𝒪sb]
              have "a  𝒪sb  all_acquired sb"
                by auto
              
              
              from  share_all_until_volatile_write_thread_local' [OF ownership_distinct_tssb sharing_consis_tssb i_bound tssb_i this] suspend_nothing
              show ?thesis by (auto simp add: domIff 𝒮)
            qed
          }
          then show ?thesis by auto
        qed
        from augment_rels_shared_exchange [OF this]
        have rel_commute:    
           "augment_rels (dom 𝒮) R (release sb (dom 𝒮sb) sb) =
           release (sb @ [Ghostsb A L R W]) (dom 𝒮sb') sb"
          by (clarsimp simp add: release_append 𝒮sb')

	have "(tssb',msb,𝒮sb')  
	   (ts[i := (psb,issb', 
	       θsb,(), 𝒟, acquired True ?take_sb 𝒪sb  A - R,
                augment_rels (dom 𝒮) R (release ?take_sb (dom 𝒮sb) sb))], 
                 m,𝒮W RA L)"
	  apply (rule sim_config.intros) 
	  apply    (simp add: m tssb' 𝒪sb' sb' θsb' flush_all_until_volatile_write_append_Ghost_commute [OF i_bound tssb_i])
	  apply   (clarsimp simp add: 𝒮 𝒮sb' tssb' sb' 𝒪sb' θsb' share_commute)
	  using  leq
	  apply  (simp add: tssb')
	  using i_bound i_bound' ts_sim ts_i True 𝒟'
	  apply (clarsimp simp add: Let_def nth_list_update 
	    outstanding_refs_conv tssb' 𝒪sb' ℛsb' 𝒮sb' θsb' sb'  𝒟sb' suspend_nothing' flush_all rel_commute
	    acquired_append split: if_split_asm)
	  done	

	ultimately show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' 
	    valid_sops'
            valid_dd' load_tmps_fresh' enough_flushs' 
	    valid_program_history' valid' msb' 𝒮sb' ℛsb'
	  by auto
      next
	case False

	then obtain r where r_in: "r  set sb" and volatile_r: "is_volatile_Writesb r"
	  by (auto simp add: outstanding_refs_conv)
	from takeWhile_dropWhile_real_prefix 
	[OF r_in, of  "(Not  is_volatile_Writesb)", simplified, OF volatile_r] 
	obtain a' v' sb'' A'' L'' R'' W'' sop' where
	  sb_split: "sb = takeWhile (Not  is_volatile_Writesb) sb @ Writesb True a' sop' v' A'' L'' R'' W''# sb''" 
	  and
	  drop: "dropWhile (Not  is_volatile_Writesb) sb = Writesb True a' sop' v' A'' L'' R'' W''# sb''"
	  apply (auto)
    subgoal for y ys
	  apply (case_tac y)
	  apply auto
	  done
	  done
	from drop suspends have suspends: "suspends = Writesb True a' sop' v' A'' L'' R'' W''# sb''"
	  by simp

	have "(ts, m, 𝒮) d* (ts, m, 𝒮)" by auto
	moreover

	have "Writesb True a' sop' v' A'' L'' R'' W'' set sb"
	  by (subst sb_split) auto
	note drop_app = dropWhile_append1 
	[OF this, of "(Not  is_volatile_Writesb)", simplified]

	from takeWhile_append1 [where P="Not  is_volatile_Writesb", OF r_in] volatile_r
	have takeWhile_app: 
	  "(takeWhile (Not  is_volatile_Writesb) (sb @ [Ghostsb A L R W])) = (takeWhile (Not  is_volatile_Writesb) sb)"
	  by simp

	note share_commute = share_all_until_volatile_write_append_Ghostsb' [OF False i_bound tssb_i]
	
	from 𝒟
	have 𝒟': "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb (sb@[Ghostsb A L R W])   {})"
	  by (auto simp: outstanding_refs_append)


	have "(tssb',msb,𝒮sb')  (ts,m,𝒮)"
	  apply (rule sim_config.intros) 
	  apply    (simp add: m flush_all_until_volatile_write_append_Ghost_commute [OF i_bound tssb_i] tssb' 𝒪sb' θsb' sb')
	  apply   (clarsimp simp add: 𝒮 𝒮sb' tssb' sb' 𝒪sb' θsb' share_commute)
	  using  leq
	  apply  (simp add: tssb')
	  using i_bound i_bound' ts_sim ts_i is_sim 𝒟'
	  apply (clarsimp simp add: Let_def nth_list_update is_sim drop_app
	    read_tmps_append suspends 
	    prog_instrs_append_Ghostsb instrs_append_Ghostsb hd_prog_append_Ghostsb
	    drop "issb" tssb' sb' 𝒪sb' ℛsb' 𝒮sb' θsb' 𝒟sb' takeWhile_app split: if_split_asm)
	  done
	ultimately show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_dd'
	    valid_sops' load_tmps_fresh' enough_flushs' 
	    valid_program_history' valid' msb' 𝒮sb' 
	  by (auto simp del: fun_upd_apply )
      qed	
    qed
  next
    case (StoreBuffer i psb "issb" θsb sb 𝒟sb 𝒪sb  sb sb' 𝒪sb' sb')
    then obtain 
      
      tssb': "tssb' = tssb[i := (psb, issb, θsb, sb', 𝒟sb, 𝒪sb',sb')]" and
      i_bound: "i < length tssb" and
      tssb_i: "tssb ! i = (psb, issb, θsb,sb, 𝒟sb, 𝒪sb,sb)" and
      flush: "(msb,sb,𝒪sb,sb,𝒮sb) f 
              (msb',sb',𝒪sb',sb',𝒮sb')" 
      by auto

    from sim obtain 
      m: "m = flush_all_until_volatile_write tssb msb" and
      𝒮: "𝒮 = share_all_until_volatile_write tssb 𝒮sb" and
      leq: "length tssb = length ts" and
      ts_sim: "i<length tssb.
           let (p, issb, θ, sb,𝒟sb, 𝒪sb,) = tssb ! i;
               suspends = dropWhile (Not  is_volatile_Writesb) sb
           in  is 𝒟. instrs suspends @ issb = is @ prog_instrs suspends  
                          𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb sb  {}) 
               ts ! i =
                   (hd_prog p suspends, 
                    is,
                    θ |` (dom θ - read_tmps suspends), (),
                    𝒟, 
                    acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪sb,
                    release (takeWhile (Not  is_volatile_Writesb) sb) (dom 𝒮sb) )"
      by cases blast

    from i_bound leq have i_bound': "i < length ts"
      by auto


    have split_sb: "sb = takeWhile (Not  is_volatile_Writesb) sb @ dropWhile (Not  is_volatile_Writesb) sb"
      (is "sb = ?take_sb@?drop_sb")
      by simp

    from ts_sim [rule_format, OF i_bound] tssb_i obtain suspends "is" 𝒟 where
      suspends: "suspends = dropWhile (Not  is_volatile_Writesb) sb" and
      is_sim: "instrs suspends @ issb = is @ prog_instrs suspends" and
      𝒟: "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb sb  {})" and
      ts_i: "ts ! i =
          (hd_prog psb suspends, is,
           θsb |` (dom θsb - read_tmps suspends), (),𝒟, acquired True ?take_sb 𝒪sb,
           release ?take_sb (dom 𝒮sb) sb)"
      by (auto simp add: Let_def)

    from flush_step_preserves_valid [OF i_bound tssb_i flush valid]
    have valid': "valid tssb'" 
      by (simp add: tssb')

    from flush obtain r where sb: "sb=r#sb'"
      by (cases) auto

    from valid_history [OF i_bound tssb_i]
    have "history_consistent θsb (hd_prog psb sb) sb".
    then
    have hist_consis': "history_consistent θsb (hd_prog psb sb') sb'"
      by (auto simp add: sb intro: history_consistent_hd_prog 
	split: memref.splits option.splits)
    from valid_history_nth_update [OF i_bound this]
    have valid_hist': "valid_history program_step tssb'" by (simp add: tssb')

    from read_tmps_distinct [OF i_bound tssb_i]
    have dist_sb': "distinct_read_tmps sb'"
      by (simp add: sb split: memref.splits)

    have tmps_distinct': "tmps_distinct tssb'"
    proof (intro_locales)
      from load_tmps_distinct [OF i_bound tssb_i]
      have "distinct_load_tmps issb".
	
      from load_tmps_distinct_nth_update [OF i_bound this]
      show "load_tmps_distinct tssb'"
	by (simp add: tssb')
    next
      from read_tmps_distinct_nth_update [OF i_bound dist_sb']
      show "read_tmps_distinct tssb'"
	by (simp add: tssb')
    next
      from load_tmps_read_tmps_distinct [OF i_bound tssb_i]
      have "load_tmps issb  read_tmps sb' = {}"
	by (auto simp add: sb split: memref.splits)
      from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
      show "load_tmps_read_tmps_distinct tssb'" by (simp add: tssb')
    qed

    from load_tmps_write_tmps_distinct [OF i_bound tssb_i]
    have "load_tmps issb  (fst ` write_sops sb') = {}"
      by (auto simp add: sb split: memref.splits)
    from valid_data_dependency_nth_update 
     [OF i_bound data_dependency_consistent_instrs [OF i_bound tssb_i] this]
    have valid_dd': "valid_data_dependency tssb'"
      by (simp add: tssb')

    from valid_store_sops [OF i_bound tssb_i] valid_write_sops [OF i_bound tssb_i] 
    valid_sops_nth_update [OF i_bound]
    have valid_sops': "valid_sops tssb'"
      by (cases r) (auto simp add: sb tssb')
    
    have load_tmps_fresh': "load_tmps_fresh tssb'"
    proof -
      from load_tmps_fresh [OF i_bound tssb_i] 
      have "load_tmps issb  dom θsb = {}".
      from load_tmps_fresh_nth_update [OF i_bound this]
      show ?thesis by (simp add: tssb')
    qed

    have enough_flushs': "enough_flushs tssb'"
    proof -
      from clean_no_outstanding_volatile_Writesb [OF i_bound tssb_i]
      have "¬ 𝒟sb  outstanding_refs is_volatile_Writesb sb' = {}"
	by (auto simp add: sb split: if_split_asm)
      from enough_flushs_nth_update [OF i_bound this]
      show ?thesis
	by (simp add: tssb' sb)
    qed

    show ?thesis
    proof (cases r)
      case (Writesb volatile a sop v A L R W)
      from flush this
      have msb': "msb' = (msb(a := v))"
	by cases (auto simp add: sb)

      have non_volatile_owned: "¬ volatile  a  𝒪sb"
      proof (cases volatile)
	case True thus ?thesis by simp
      next
	case False
	with outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i] 
	have "a  𝒪sb"
	  by (simp add: sb Writesb)
	thus ?thesis by simp
      qed

      have a_unowned_by_others:
	"j < length tssb. i  j  (let (_,_,_,sbj,_,𝒪j,_) = tssb ! j in 
	a  𝒪j  all_acquired sbj)"
      proof (unfold Let_def, clarify del: notI)
	fix j pj "isj" 𝒪j j 𝒟j θj sbj
	assume j_bound: "j < length tssb"
	assume neq: "i  j"
	assume ts_j: "tssb ! j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	show "a  𝒪j  all_acquired sbj"
	proof (cases volatile)
	  case True
	  from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound neq 
           tssb_i ts_j] 
	  show ?thesis 
	    by (simp add: sb Writesb True)
	next
	  case False
	  with non_volatile_owned
	  have "a  𝒪sb"
	    by simp
	  with ownership_distinct [OF i_bound j_bound neq tssb_i ts_j]
	  show ?thesis
	    by blast
	qed
      qed

      from valid_reads [OF i_bound tssb_i]
      have reads_consis: "reads_consistent False 𝒪sb msb sb" .


      {
	fix j 
	fix pj issbj 𝒪j j 𝒟sbj θj sbj
	assume j_bound: "j < length tssb"
	assume tssb_j: "tssb!j=(pj,issbj,θj,sbj,𝒟sbj,𝒪j,j)"
	assume neq_i_j: "ij"
	have "a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	proof 
	  assume "a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	  hence "a  outstanding_refs is_non_volatile_Writesb (takeWhile (Not  is_volatile_Writesb) sbj)"
	    by (simp add: outstanding_refs_is_non_volatile_Writesb_takeWhile_conv)
	  hence "a  outstanding_refs is_non_volatile_Writesb sbj"
	    using outstanding_refs_append [of _ "(takeWhile (Not  is_volatile_Writesb) sbj)" 
	      "(dropWhile (Not  is_volatile_Writesb) sbj)"]
	    by auto
	  with non_volatile_owned_or_read_only_outstanding_non_volatile_writes 
	  [OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound tssb_j]]
	  have "a  𝒪j  all_acquired sbj"
	    by auto
	  with a_unowned_by_others [rule_format, OF j_bound neq_i_j]  tssb_j
	  show False
	    by auto
	qed
      }
      note a_notin_others = this

	
      from a_notin_others
      have a_notin_others': 
	"j < length tssb. i  j 
        (let (_,_,_,sbj,_,_,_) = tssb!j in a  outstanding_refs is_Writesb (takeWhile (Not  is_volatile_Writesb) sbj))"
	by (fastforce simp add: Let_def)
      

      
      obtain D f where sop: "sop=(D,f)" by (cases sop) auto
      from valid_history [OF i_bound tssb_i] sop sb Writesb
      obtain D_tmps: "D  dom θsb" and f_v: "f θsb = v" and
	 D_sb': "D  read_tmps sb' = {}"
	by auto
      let  = "(θsb |` (dom θsb - read_tmps sb'))"
      from D_tmps D_sb'
      have D_tmps': "D  dom "
	by auto
      from valid_write_sops [OF i_bound tssb_i, rule_format, of sop]
      have "valid_sop sop"
	by (auto simp add: sb Writesb)
      from this [simplified sop]
      interpret valid_sop "(D,f)" .
      from D_tmps D_sb' 
      have "((dom θsb - read_tmps sb')  D) = D"
	by blast
      with valid_sop [OF refl D_tmps] valid_sop [OF refl D_tmps']  f_v 
      have f_v': "f  = v"
	by auto

      have valid_program_history': "valid_program_history tssb'"
      proof -	
	from valid_program_history [OF i_bound tssb_i]
	have "causal_program_history issb sb" .
	then have causal': "causal_program_history issb sb'"
	  by (simp add: sb Writesb causal_program_history_def)

	from valid_last_prog [OF i_bound tssb_i]
	have "last_prog psb sb = psb".
	hence "last_prog psb sb' = psb"
	  by (simp add: sb Writesb)

	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb')
      qed



      show ?thesis
      proof (cases volatile)
	case True
	note volatile = this
	from flush Writesb volatile
	obtain 
	  𝒪sb': "𝒪sb'=𝒪sb  A - R" and
	  𝒮sb': "𝒮sb'= 𝒮sbW RA L" andsb': "sb' = Map.empty"
	  by cases (auto  simp add: sb)

	from sharing_consis [OF i_bound tssb_i] 
	obtain 
	  A_shared_owned: "A  dom 𝒮sb  𝒪sb" and
	  L_subset: "L  A" and
	  A_R: "A  R = {}" and
	  R_owned: "R  𝒪sb"
	  by (clarsimp simp add: sb Writesb volatile)


	 
	from sb Writesb True have take_empty: "takeWhile (Not  is_volatile_Writesb) sb = []"
	  by (auto simp add: outstanding_refs_conv)
	
	from sb Writesb True have suspend_all: "dropWhile (Not  is_volatile_Writesb) sb = sb"
	  by (auto simp add: outstanding_refs_conv)

	hence suspends_all: "suspends = sb"
	  by (simp add: suspends)

	from is_sim 
	have is_sim: "Write True a (D, f) A L R W# instrs sb' @ issb = is @ prog_instrs sb'"
	  by (simp add: True Writesb suspends_all sb sop)

	from valid_program_history [OF i_bound tssb_i]
	interpret causal_program_history "issb" sb .
	from valid_last_prog [OF i_bound tssb_i]
	have last_prog: "last_prog psb sb = psb".

	from causal_program_history [of "[Writesb True a (D, f) v A L R W]" sb'] is_sim 
	obtain is' where 
	  "is": "is = Write True a (D, f) A L R W# is'" and
	  is'_sim: "instrs sb'@issb = is' @ prog_instrs sb'" 
	  by (auto simp add: sb Writesb volatile sop)
	  
	from causal_program_history have
	  causal_program_history_sb': "causal_program_history issb sb'"
	  apply -
	  apply (rule causal_program_history.intro)
	  apply (auto simp add: sb Writesb)
	  done

	from ts_i have ts_i: "ts ! i =
          (hd_prog psb sb', Write True a (D, f) A L R W# is',  , (), 𝒟,acquired True ?take_sb 𝒪sb,
           release ?take_sb (dom 𝒮sb) sb)"	
	  by (simp add: suspends_all sb Writesb "is")

	let ?ts' = "ts[i := (hd_prog psb sb', is', , (), True, acquired True ?take_sb 𝒪sb  A - R,
                       Map.empty)]"

	from i_bound' have ts'_i: "?ts'!i = (hd_prog psb sb', is', , (),True, acquired True ?take_sb 𝒪sb  A - R,Map.empty)" 
	  by simp

	from no_outstanding_write_to_read_only_memory [OF i_bound tssb_i]
	have a_not_ro: "a  read_only 𝒮sb"
	  by (clarsimp simp add: sb Writesb volatile)

	{
	  fix j 
	  fix pj issbj 𝒪j j 𝒟sbj θj sbj
	  assume j_bound: "j < length tssb"
	  assume tssb_j: "tssb!j=(pj,issbj,θj,sbj,𝒟sbj,𝒪j,j)"
	  assume neq_i_j: "ij"
	  have "a  unforwarded_non_volatile_reads (dropWhile (Not  is_volatile_Writesb) sbj) {}"
	  proof 
	    let ?take_sbj = "takeWhile (Not  is_volatile_Writesb) sbj"
	    let ?drop_sbj = "dropWhile (Not  is_volatile_Writesb) sbj"
	    assume a_in: "a   unforwarded_non_volatile_reads ?drop_sbj {}"
	    
	    from a_unowned_by_others [rule_format, OF j_bound neq_i_j] tssb_j 
	    obtain a_unowned: "a  𝒪j" and a_unacq: "a  all_acquired sbj"
	      by auto
	    with all_acquired_append [of ?take_sbj ?drop_sbj] acquired_takeWhile_non_volatile_Writesb [of sbj 𝒪j]
	    have a_unacq_take: "a  acquired True ?take_sbj 𝒪j"
	      by (auto simp add: )

	    note nvo_j = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound tssb_j]
	  
	    from non_volatile_owned_or_read_only_drop [OF nvo_j]
	    have nvo_drop_j: "non_volatile_owned_or_read_only True (share ?take_sbj 𝒮sb)
	      (acquired True ?take_sbj 𝒪j) ?drop_sbj" .

	    note consis_j = sharing_consis [OF j_bound tssb_j]
	    with sharing_consistent_append [of 𝒮sb 𝒪j ?take_sbj ?drop_sbj]
	    obtain consis_take_j: "sharing_consistent 𝒮sb 𝒪j ?take_sbj" and
	      consis_drop_j: "sharing_consistent (share ?take_sbj 𝒮sb)
	      (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	      by auto

	    from in_unforwarded_non_volatile_reads_non_volatile_Readsb [OF a_in]
	    have a_in': "a  outstanding_refs is_non_volatile_Readsb ?drop_sbj".
	    
	    note reads_consis_j = valid_reads [OF j_bound tssb_j]
	    from reads_consistent_drop [OF this]
	    have reads_consis_drop_j:
	      "reads_consistent True (acquired True ?take_sbj 𝒪j) (flush ?take_sbj msb) ?drop_sbj".
	    

            
            from read_only_share_all_shared [of a ?take_sbj 𝒮sb] a_not_ro 
              all_shared_acquired_or_owned [OF consis_take_j]
              all_acquired_append [of ?take_sbj ?drop_sbj] a_unowned a_unacq
	    have a_not_ro_j: "a  read_only (share ?take_sbj 𝒮sb)"
              by auto
	    
	  
	    from ts_sim [rule_format, OF j_bound] tssb_j j_bound
	    obtain suspendsj "isj" 𝒟j j where
	      suspendsj: "suspendsj = ?drop_sbj" and
	      isj: "instrs suspendsj @ issbj = isj @ prog_instrs suspendsj" and
	      𝒟j: "𝒟sbj = (𝒟j  outstanding_refs is_volatile_Writesb sbj  {})" and
	      tsj: "ts!j = (hd_prog pj suspendsj, isj, 
	      θj |` (dom θj - read_tmps suspendsj),(),   
	      𝒟j, acquired True ?take_sbj 𝒪j,j)"
	      by (auto simp: Let_def)

	    from valid_last_prog [OF j_bound tssb_j] have last_prog: "last_prog pj sbj = pj".
	    

	    from j_bound i_bound' leq have j_bound_ts': "j < length ts"
	      by simp
	    from read_only_read_acquired_unforwarded_acquire_witness [OF nvo_drop_j consis_drop_j
	      a_not_ro_j a_unacq_take a_in]

	    have False
	    proof
	      assume "sop a' v ys zs A L R W. 
		?drop_sbj = ys @ Writesb True a' sop v A L R W # zs  a  A  
		a  outstanding_refs is_Writesb ys  a'a"
	      with suspendsj 
	      obtain a' sop' v' ys zs' A' L' R' W' where
		split_suspendsj: "suspendsj = ys @ Writesb True a' sop' v' A' L' R' W'# zs'" (is "suspendsj=?suspends") and
		a_A': "a  A'" and
		no_write: "a  outstanding_refs is_Writesb (ys @ [Writesb True a' sop' v' A' L' R' W'])"
		by (auto simp add: outstanding_refs_append)

	      from last_prog
	      have lp: "last_prog pj suspendsj = pj"
		apply -
		apply (rule last_prog_same_append [where sb="?take_sbj"])
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done

	      from sharing_consis [OF j_bound tssb_j]
	      have sharing_consis_j: "sharing_consistent 𝒮sb 𝒪j sbj".
	      then have A'_R': "A'  R' = {}" 
		by (simp add: sharing_consistent_append [of _ _ ?take_sbj ?drop_sbj, simplified] 
		  suspendsj [symmetric] split_suspendsj sharing_consistent_append)	  
	      
	      from valid_program_history [OF j_bound tssb_j] 
	      have "causal_program_history issbj sbj".
	      then have cph: "causal_program_history issbj ?suspends"
		apply -
		apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply (simp add: split_suspendsj)
		done
	      
	      from valid_reads [OF j_bound tssb_j]
	      have reads_consis_j: "reads_consistent False 𝒪j msb sbj".
	      
	      from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb 
		j_bound tssb_j this]
	      have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		by (simp add: m suspendsj)
	    
	      hence reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  
		m (ys@[Writesb True a' sop' v' A' L' R' W'])"
		by (simp add: split_suspendsj reads_consistent_append)

	      from valid_write_sops [OF j_bound tssb_j]
	      have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		valid_sops_drop: "sopwrite_sops (ys@[Writesb True a' sop' v' A' L' R' W']). valid_sop sop"
		apply (simp only: write_sops_append)
		apply auto
		done
	    
	      from read_tmps_distinct [OF j_bound tssb_j]
	      have "distinct_read_tmps (?take_sbj@suspendsj)"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain 
		read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
		distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		apply (simp only: distinct_read_tmps_append)
		done
	    
	      from valid_history [OF j_bound tssb_j]
	      have h_consis: 
		"history_consistent θj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done
	      
	      have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	      proof -
		from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		  by simp
		from last_prog_hd_prog_append' [OF h_consis] this
		have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		  by (simp only: split_suspendsj [symmetric] suspendsj) 
		moreover 
		have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		  last_prog (hd_prog pj suspendsj) ?take_sbj"
		  apply (simp only: split_suspendsj [symmetric] suspendsj) 
		  by (rule last_prog_hd_prog_append)
		ultimately show ?thesis
		  by (simp add: split_suspendsj [symmetric] suspendsj) 
	      qed

	      from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
		h_consis] last_prog_hd_prog
	      have hist_consis': "history_consistent θj (hd_prog pj suspendsj) suspendsj"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      from reads_consistent_drop_volatile_writes_no_volatile_reads  
	      [OF reads_consis_j] 
	      have no_vol_read: "outstanding_refs is_volatile_Readsb 
		(ys@[Writesb True a' sop' v' A' L' R' W']) = {}"
		by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		split_suspendsj )
	    
	      have acq_simp:
		"acquired True (ys @ [Writesb True a' sop' v' A' L' R' W']) 
		(acquired True ?take_sbj 𝒪j) = 
		acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R'"
		by (simp add: acquired_append)

	      from flush_store_buffer_append [where sb="ys@[Writesb True a' sop' v' A' L' R' W']" and sb'="zs'", simplified,
	      OF j_bound_ts' isj [simplified split_suspendsj] cph [simplified suspendsj]  tsj [simplified split_suspendsj]
	      refl lp [simplified split_suspendsj] reads_consis_ys 	      
	      hist_consis' [simplified split_suspendsj] valid_sops_drop 
	      distinct_read_tmps_drop [simplified split_suspendsj] 
	      no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
	      𝒮="𝒮"]
	    
	      obtain isj' j' where
		isj': "instrs zs' @ issbj = isj' @ prog_instrs zs'" and
		steps_ys: "(ts, m, 𝒮)  d* 
		  (ts[j:=(last_prog
                              (hd_prog pj (Writesb True a' sop' v' A' L' R' W'# zs')) (ys@[Writesb True a' sop' v' A' L' R' W']),
                             isj',
                             θj |` (dom θj - read_tmps zs'),
                              (), True, acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R',j')],
                    flush (ys@[Writesb True a' sop' v' A' L' R' W']) m,
                    share (ys@[Writesb True a' sop' v' A' L' R' W']) 𝒮)"
		(is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
		by (auto simp add: acquired_append outstanding_refs_append)

	      from i_bound' have i_bound_ys: "i < length ?ts_ys"
		by auto
	    
	      from i_bound' neq_i_j  ts_i
	      have ts_ys_i: "?ts_ys!i = (hd_prog psb sb', Write True a (D, f) A L R W# is', , (), 𝒟, 
		acquired True ?take_sb 𝒪sb,release ?take_sb (dom 𝒮sb) sb)"
		by simp
	      
	      note conflict_computation = steps_ys
	      
	      from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	      have safe: "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	      
	      with safe_delayedE [OF safe i_bound_ys ts_ys_i] 
	      have a_unowned: 
		"j < length ?ts_ys. ij  (let (𝒪j) = map owned ?ts_ys!j in a  𝒪j)"
		apply cases
		apply (auto simp add: Let_def sb)
		done
	      from a_A' a_unowned [rule_format, of j] neq_i_j j_bound leq A'_R'
	      show False
		by (auto simp add: Let_def)
	    next
	      assume "A L R W ys zs. ?drop_sbj = ys @ Ghostsb A L R W# zs  a  A  a  outstanding_refs is_Writesb ys"
	      with suspendsj 
	      obtain ys zs' A' L' R' W' where
		split_suspendsj: "suspendsj = ys @ Ghostsb A' L' R' W'# zs'" (is "suspendsj=?suspends") and
		a_A': "a  A'" and
		no_write: "a  outstanding_refs is_Writesb (ys @ [Ghostsb A' L' R' W'])"
		by (auto simp add: outstanding_refs_append)

	      from last_prog
	      have lp: "last_prog pj suspendsj = pj"
		apply -
		apply (rule last_prog_same_append [where sb="?take_sbj"])
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done


	      from valid_program_history [OF j_bound tssb_j] 
	      have "causal_program_history issbj sbj".
	      then have cph: "causal_program_history issbj ?suspends"
		apply -
		apply (rule causal_program_history_suffix [where sb="?take_sbj"] )
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply (simp add: split_suspendsj)
		done
	    
	      from valid_reads [OF j_bound tssb_j]
	      have reads_consis_j: "reads_consistent False 𝒪j msb sbj".
	    
	      from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb 
		j_bound tssb_j this]
	      have reads_consis_m_j: "reads_consistent True (acquired True ?take_sbj 𝒪j) m suspendsj"
		by (simp add: m suspendsj)
	    
	    
	      hence reads_consis_ys: "reads_consistent True (acquired True ?take_sbj 𝒪j)  
		m (ys@[Ghostsb A' L' R' W'])"
		by (simp add: split_suspendsj reads_consistent_append)

	      from valid_write_sops [OF j_bound tssb_j]
	      have "sopwrite_sops (?take_sbj@?suspends). valid_sop sop"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain valid_sops_take: "sopwrite_sops ?take_sbj. valid_sop sop" and
		valid_sops_drop: "sopwrite_sops (ys@[Ghostsb A' L' R' W']). valid_sop sop"
		apply (simp only: write_sops_append)
		apply auto
		done
	      
	      from read_tmps_distinct [OF j_bound tssb_j]
	      have "distinct_read_tmps (?take_sbj@suspendsj)"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      then obtain 
		read_tmps_take_drop: "read_tmps ?take_sbj  read_tmps suspendsj = {}" and
		distinct_read_tmps_drop: "distinct_read_tmps suspendsj"
		apply (simp only: split_suspendsj [symmetric] suspendsj) 
		apply (simp only: distinct_read_tmps_append)
		done
	    
	      from valid_history [OF j_bound tssb_j]
	      have h_consis: 
		"history_consistent θj (hd_prog pj (?take_sbj@suspendsj)) (?take_sbj@suspendsj)"
		apply (simp only: split_suspendsj [symmetric] suspendsj)
		apply simp
		done
	    
	      from sharing_consis [OF j_bound tssb_j]
	      have sharing_consis_j: "sharing_consistent 𝒮sb 𝒪j sbj".
	      then have A'_R': "A'  R' = {}" 
		by (simp add: sharing_consistent_append [of _ _ ?take_sbj ?drop_sbj, simplified] 
		  suspendsj [symmetric] split_suspendsj sharing_consistent_append)	  

	      have last_prog_hd_prog: "last_prog (hd_prog pj sbj) ?take_sbj = (hd_prog pj suspendsj)"
	      proof -
		from last_prog have "last_prog pj (?take_sbj@?drop_sbj) = pj"
		  by simp
		from last_prog_hd_prog_append' [OF h_consis] this
		have "last_prog (hd_prog pj suspendsj) ?take_sbj = hd_prog pj suspendsj"
		  by (simp only: split_suspendsj [symmetric] suspendsj) 
		moreover 
		have "last_prog (hd_prog pj (?take_sbj @ suspendsj)) ?take_sbj = 
		  last_prog (hd_prog pj suspendsj) ?take_sbj"
		  apply (simp only: split_suspendsj [symmetric] suspendsj) 
		  by (rule last_prog_hd_prog_append)
		ultimately show ?thesis
		  by (simp add: split_suspendsj [symmetric] suspendsj) 
	      qed
	      
	      from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop 
		h_consis] last_prog_hd_prog
	      have hist_consis': "history_consistent θj (hd_prog pj suspendsj) suspendsj"
		by (simp add: split_suspendsj [symmetric] suspendsj)
	      from reads_consistent_drop_volatile_writes_no_volatile_reads  
	      [OF reads_consis_j] 
	      have no_vol_read: "outstanding_refs is_volatile_Readsb 
	      (ys@[Ghostsb A' L' R' W']) = {}"
		by (auto simp add: outstanding_refs_append suspendsj [symmetric] 
		  split_suspendsj )
	    
	      have acq_simp:
		"acquired True (ys @ [Ghostsb A' L' R' W']) 
		(acquired True ?take_sbj 𝒪j) = 
		acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R'"
		by (simp add: acquired_append)
	    
	      from flush_store_buffer_append [where sb="ys@[Ghostsb A' L' R' W']" and sb'="zs'", simplified,
		OF j_bound_ts' isj [simplified split_suspendsj] cph [simplified suspendsj]
		tsj [simplified split_suspendsj] refl lp [simplified split_suspendsj] reads_consis_ys 
		hist_consis' [simplified split_suspendsj] valid_sops_drop 
		distinct_read_tmps_drop [simplified split_suspendsj] 
		no_volatile_Readsb_volatile_reads_consistent [OF no_vol_read], where
		𝒮="𝒮"]
	      
	      obtain isj' j' where
		isj': "instrs zs' @ issbj = isj' @ prog_instrs zs'" and
		steps_ys: "(ts, m,𝒮)  d* 
		  (ts[j:=(last_prog
                              (hd_prog pj (Ghostsb A' L' R' W'# zs')) (ys@[Ghostsb A' L' R' W']),
                             isj',
                             θj |` (dom θj - read_tmps zs'),
                              (), 
	                     𝒟j  outstanding_refs is_volatile_Writesb ys  {}, acquired True ys (acquired True ?take_sbj 𝒪j)  A' - R',j')],
                    flush (ys@[Ghostsb A' L' R' W']) m,                    share (ys@[Ghostsb A' L' R' W']) 𝒮)"
		(is "(_,_,_) d* (?ts_ys,?m_ys,?shared_ys)")
		by (auto simp add: acquired_append outstanding_refs_append)

	      from i_bound' have i_bound_ys: "i < length ?ts_ys"
		by auto
	      
	      from i_bound' neq_i_j  ts_i
	      have ts_ys_i: "?ts_ys!i = (hd_prog psb sb', Write True a (D, f) A L R W# is', , (), 𝒟, 
		acquired True ?take_sb 𝒪sb,release ?take_sb (dom 𝒮sb) sb)"
		by simp

	      note conflict_computation = steps_ys
	    
	      from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
	      have safe: "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
	          
	      with safe_delayedE [OF safe i_bound_ys ts_ys_i] 
	      have a_unowned: 
		
		"j < length ?ts_ys. ij  (let (𝒪j) = map owned ?ts_ys!j in a  𝒪j)"
		apply cases
		apply (auto simp add: Let_def sb)
		done
	      from a_A' a_unowned [rule_format, of j] neq_i_j j_bound leq A'_R'
	      show False
		by (auto simp add: Let_def)
	    qed
	    then show False
	      by simp
	  qed
	}
	note a_notin_unforwarded_non_volatile_reads_drop = this


	have valid_reads': "valid_reads msb' tssb'"
	proof (unfold_locales)
	  fix j pj "isj" 𝒪j j 𝒟j θj sbj
	  assume j_bound: "j < length tssb'"
	  assume ts_j: "tssb'!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	  show "reads_consistent False 𝒪j msb' sbj"
	  proof (cases "i=j")
	    case True
	    from reads_consis ts_j j_bound sb show ?thesis
	      by (clarsimp simp add: True  msb' Writesb tssb' 𝒪sb' volatile reads_consistent_pending_write_antimono)
	  next
	    case False
	    from j_bound have j_bound':  "j < length tssb"
	      by (simp add: tssb')
	    moreover from ts_j False have ts_j': "tssb ! j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	      using j_bound by (simp add: tssb')
	    ultimately have consis_m: "reads_consistent False 𝒪j msb sbj"
	      by (rule valid_reads)
	    from a_unowned_by_others [rule_format, OF j_bound' False] ts_j'
	    have a_unowned:"a  𝒪j  all_acquired sbj"
	      by simp

	    let ?take_sbj = "takeWhile (Not  is_volatile_Writesb) sbj"
	    let ?drop_sbj = "dropWhile (Not  is_volatile_Writesb) sbj"

	    from a_unowned acquired_reads_all_acquired [of True ?take_sbj 𝒪j]
	    all_acquired_append [of ?take_sbj ?drop_sbj]
	    have a_not_acq_reads: "a  acquired_reads True ?take_sbj 𝒪j"
	      by auto
	    moreover
	    note a_unfw= a_notin_unforwarded_non_volatile_reads_drop [OF j_bound' ts_j' False]
	    ultimately
	    show ?thesis
	      using reads_consistent_mem_eq_on_unforwarded_non_volatile_reads_drop [where W="{}" and 
		A="unforwarded_non_volatile_reads ?drop_sbj {}  acquired_reads True ?take_sbj 𝒪j" and
		m'= "(msb(a:=v))", OF _ _ _ consis_m]
	      by (fastforce simp add: msb')
	  qed
	qed
       

	have valid_own': "valid_ownership 𝒮sb' tssb'"
	proof (intro_locales)
	  show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	  proof 
	    fix j isj 𝒪j j 𝒟j θj sbj pj
	    assume j_bound: "j < length tssb'"
	    assume tssb'_j: "tssb'!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	    show "non_volatile_owned_or_read_only False 𝒮sb' 𝒪j sbj"
	    proof (cases "j=i")
	      case True
	      from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i]
	      have "non_volatile_owned_or_read_only False 
	        (𝒮sbW RA L) (𝒪sb  A - R) sb'"
		by (auto simp add: sb Writesb volatile non_volatile_owned_or_read_only_pending_write_antimono)
	      then show ?thesis
		using True i_bound tssb'_j
		by (auto simp add: tssb' 𝒮sb' sb 𝒪sb')
	    next
	      case False
	      from j_bound have j_bound': "j < length tssb"
		by (auto simp add: tssb')
	      with tssb'_j False i_bound 
	      have tssb_j: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
		by (auto simp add: tssb')
	      
	      
	      note nvo = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' tssb_j]

	      from read_only_unowned [OF i_bound tssb_i] R_owned
	      have "R  read_only 𝒮sb = {}"
		by auto
	      with read_only_reads_unowned [OF j_bound' i_bound False tssb_j tssb_i] L_subset
	      have "aread_only_reads
	      (acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j)
		(dropWhile (Not  is_volatile_Writesb) sbj).
		a  read_only 𝒮sb  a  read_only (𝒮sbW RA L)"
		by (auto simp add: in_read_only_convs sb Writesb volatile)
	      from non_volatile_owned_or_read_only_read_only_reads_eq' [OF nvo this]
	      have "non_volatile_owned_or_read_only False (𝒮sbW RA L) 𝒪j sbj".
	      thus ?thesis by (simp add: 𝒮sb')
	    qed
	  qed
	next
	  show "outstanding_volatile_writes_unowned_by_others tssb'"
	  proof (unfold_locales)
	    fix i1 j p1 "is1" 𝒪1 1 𝒟1 xs1 sb1 pj "isj" "𝒪j" j 𝒟j xsj sbj
	    assume i1_bound: "i1 < length tssb'"
	    assume j_bound: "j < length tssb'"
	    assume i1_j: "i1  j"
	    assume ts_i1: "tssb'!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	    assume ts_j: "tssb'!j = (pj,isj, xsj,sbj,𝒟j,𝒪j,j)"
	    show "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb1 = {}"
	    proof (cases "i1=i")
	      case True
	      from i1_j True have neq_i_j: "ij"
		by auto
	      from j_bound have j_bound': "j < length tssb"
		by (simp add: tssb')
	      from ts_j neq_i_j have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (simp add: tssb')
	      from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound' neq_i_j
		tssb_i ts_j'] ts_i1 i_bound tssb_i True show ?thesis
		by (clarsimp simp add: tssb' sb Writesb volatile)
	    next
	      case False
	      note i1_i = this
	      from i1_bound have i1_bound': "i1 < length tssb"
		by (simp add: tssb' sb)
	      hence i1_bound'': "i1 < length (map owned tssb)"
		by auto
	      from ts_i1 False have ts_i1': "tssb!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
		by (simp add: tssb' sb)
	      show ?thesis
	      proof (cases "j=i")
		case True
		from outstanding_volatile_writes_unowned_by_others [OF i1_bound' i_bound  i1_i  ts_i1' tssb_i ]
		have "(𝒪sb  all_acquired sb)  outstanding_refs is_volatile_Writesb sb1 = {}".
		then show ?thesis
		  using True i1_i ts_j tssb_i i_bound
		  by (auto simp add: sb Writesb volatile tssb' 𝒪sb')
	      next
		case False
		from j_bound have j_bound': "j < length tssb"
		  by (simp add: tssb')
		from ts_j False have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		  by (simp add: tssb')
		from outstanding_volatile_writes_unowned_by_others 
		[OF i1_bound' j_bound' i1_j ts_i1' ts_j']
		show "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb1 = {}" .
	      qed
	    qed
	  qed
	next
	  show "read_only_reads_unowned tssb'"
	  proof 
	    fix n m
	    fix pn "isn" 𝒪n n 𝒟n θn sbn pm "ism" 𝒪m m 𝒟m θm sbm
	    assume n_bound: "n < length tssb'"
	      and m_bound: "m < length tssb'"
	      and neq_n_m: "nm"
	      and nth: "tssb'!n = (pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
	      and mth: "tssb'!m =(pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
	    from n_bound have n_bound': "n < length tssb" by (simp add: tssb')
	    from m_bound have m_bound': "m < length tssb" by (simp add: tssb')
	    show "(𝒪m  all_acquired sbm) 
              read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbn) 𝒪n)
              (dropWhile (Not  is_volatile_Writesb) sbn) =
              {}"
	    proof (cases "m=i")
	      case True
	      with neq_n_m have neq_n_i: "ni"
		by auto
	      
	      with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
		by (auto simp add: tssb')
	      note read_only_reads_unowned [OF n_bound' i_bound  neq_n_i nth' tssb_i]
	      then
	      show ?thesis
		using True tssb_i neq_n_i nth mth n_bound' m_bound' L_subset
		by (auto simp add: tssb' 𝒪sb' sb Writesb volatile)
	    next
	      case False
	      note neq_m_i = this
	      with m_bound mth i_bound have mth': "tssb!m = (pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
		by (auto simp add: tssb')
	      show ?thesis
	      proof (cases "n=i")
		case True
		from read_only_reads_append [of "(𝒪sb  A - R)" "(takeWhile (Not  is_volatile_Writesb) sbn)"
		  "(dropWhile (Not  is_volatile_Writesb) sbn)"]
		have "read_only_reads
                  (acquired True (takeWhile (Not  is_volatile_Writesb) sbn) (𝒪sb  A - R))
                  (dropWhile (Not  is_volatile_Writesb) sbn)  read_only_reads (𝒪sb  A - R) sbn"
		  by auto
		
		with tssb_i nth mth neq_m_i n_bound' True
		  read_only_reads_unowned [OF i_bound m_bound' False [symmetric] tssb_i mth']
		show ?thesis
		  by (auto simp add: tssb'  sb 𝒪sb' Writesb volatile)
	      next
		case False
		with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
		  by (auto simp add: tssb')
		from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m  nth' mth'] False neq_m_i
		show ?thesis 
		  by (clarsimp)
	      qed
	    qed
	  qed
	next
	  show "ownership_distinct tssb'"
	  proof (unfold_locales)
	    fix i1 j p1 "is1" 𝒪1 1 𝒟1 xs1 sb1 pj "isj" "𝒪j" j 𝒟j xsj sbj
	    assume i1_bound: "i1 < length tssb'"
	    assume j_bound: "j < length tssb'"
	    assume i1_j: "i1  j"
	    assume ts_i1: "tssb'!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	    assume ts_j: "tssb'!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	    show "(𝒪1  all_acquired sb1)  (𝒪j  all_acquired sbj)= {}"
	    proof (cases "i1=i")
	      case True
	      with i1_j have i_j: "ij" 
		by simp
	      
	      from j_bound have j_bound': "j < length tssb"
		by (simp add: tssb')
	      hence j_bound'': "j < length (map owned tssb)"
		by simp	    
	      from ts_j i_j have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (simp add: tssb')
	      
	      from ownership_distinct [OF i_bound j_bound' i_j tssb_i ts_j']
	      show ?thesis
		using tssb_i True ts_i1 i_bound 𝒪sb'
		by (auto simp add: tssb' sb Writesb volatile)
	    next
	      case False
	      note i1_i = this
	      from i1_bound have i1_bound': "i1 < length tssb"
		by (simp add: tssb')
	      hence i1_bound'': "i1 < length (map owned tssb)"
		by simp	    
	      from ts_i1 False have ts_i1': "tssb!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
		by (simp add: tssb')
	      show ?thesis
	      proof (cases "j=i")
		case True
		from ownership_distinct [OF i1_bound' i_bound  i1_i ts_i1' tssb_i]
		show ?thesis
		  using tssb_i True ts_j i_bound 𝒪sb'
		  by (auto simp add: tssb' sb Writesb volatile)
	      next
		case False
		from j_bound have j_bound': "j < length tssb"
		  by (simp add: tssb')
		from ts_j False have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		  by (simp add: tssb')
		from ownership_distinct [OF i1_bound' j_bound' i1_j ts_i1' ts_j']
		show ?thesis .
	      qed
	    qed
	  qed
	qed

	have valid_sharing': "valid_sharing (𝒮sbW RA L) tssb'"
	proof (intro_locales)	
	  show "outstanding_non_volatile_writes_unshared (𝒮sbW RA L) tssb'"
	  proof (unfold_locales)
	    fix j pj "isj" "𝒪j" j 𝒟j acqj xsj sbj
	    assume j_bound: "j < length tssb'"
	    assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	    show "non_volatile_writes_unshared (𝒮sbW RA L)  sbj"
	    proof (cases "i=j")
	      case True
	      with outstanding_non_volatile_writes_unshared [OF i_bound tssb_i]
		i_bound jth tssb_i show ?thesis
		by (clarsimp simp add: tssb' sb Writesb volatile)
	    next
	      case False
	      from j_bound have j_bound': "j < length tssb"
		by (auto simp add: tssb')
	      from jth False have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (auto simp add: tssb')
	      from outstanding_non_volatile_writes_unshared [OF j_bound' jth']
	      have unshared: "non_volatile_writes_unshared 𝒮sb sbj".
	      
	      have "adom (𝒮sbW RA L) - dom 𝒮sb. a  outstanding_refs is_non_volatile_Writesb sbj"
	      proof -
		{
		  fix a 
		  assume a_in: "a  dom (𝒮sbW RA L) - dom 𝒮sb"
		  hence a_R: "a  R"
		    by clarsimp
		  assume a_in_j: "a  outstanding_refs is_non_volatile_Writesb sbj"
		  have False
		  proof -
		    from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF
		      outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
		      a_in_j
		    have "a  𝒪j  all_acquired sbj"
		      by auto

		    moreover
		    with ownership_distinct [OF i_bound j_bound' False tssb_i jth'] a_R R_owned
		    show False
		      by blast
		  qed
		}
		thus ?thesis by blast
	      qed
		  
		

	      from non_volatile_writes_unshared_no_outstanding_non_volatile_Writesb 
	      [OF unshared this]
	      show ?thesis .
	    qed
	  qed
	next
	  show "sharing_consis (𝒮sbW RA L) tssb'"
	  proof (unfold_locales)  
	    fix j pj "isj" "𝒪j" j 𝒟j xsj sbj
	    assume j_bound: "j < length tssb'"
	    assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	    show "sharing_consistent (𝒮sbW RA L) 𝒪j sbj"
	    proof (cases "i=j")
	      case True
	      with i_bound jth tssb_i sharing_consis [OF i_bound tssb_i]
	      show ?thesis
		by (clarsimp simp add: tssb' sb Writesb volatile 𝒪sb')
	    next
	      case False
	      from j_bound have j_bound': "j < length tssb"
		by (auto simp add: tssb')
	      from jth False have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (auto simp add: tssb')
	      from sharing_consis [OF j_bound' jth']
	      have consis: "sharing_consistent 𝒮sb 𝒪j sbj".
	      
	      have acq_cond: "all_acquired sbj  dom 𝒮sb - dom (𝒮sbW RA L) = {}"
	      proof -
		{
		  fix a
		  assume a_acq: "a  all_acquired sbj" 
		  assume "a  dom 𝒮sb" 
		  assume a_L: "a  L"
		  have False
		  proof -
		    from ownership_distinct [OF i_bound j_bound' False tssb_i jth']
		    have "A  all_acquired sbj = {}"
		      by (auto simp add: sb Writesb volatile)
		    with a_acq a_L L_subset
		    show False
		      by blast
		  qed
		}
		thus ?thesis
		  by auto
	      qed
	      have uns_cond: "all_unshared sbj  dom (𝒮sbW RA L) - dom 𝒮sb = {}"
	      proof -
		{
		  fix a
		  assume a_uns: "a  all_unshared sbj" 
		  assume "a  L" 
		  assume a_R:  "a  R"
		  have False
		  proof -
		    from unshared_acquired_or_owned [OF consis] a_uns
		    have "a  all_acquired sbj  𝒪j" by auto
		    with ownership_distinct [OF i_bound j_bound' False tssb_i jth']  R_owned a_R
		    show False
		      by blast
		  qed
		}
		thus ?thesis
		  by auto
	      qed
	      
	      from sharing_consistent_preservation [OF consis acq_cond uns_cond]
	      show ?thesis
		by (simp add: tssb')
	    qed
	  qed
	next
	  show "read_only_unowned (𝒮sbW RA L) tssb'"
	  proof 
	    fix j pj "isj" "𝒪j" j  𝒟j xsj sbj
	    assume j_bound: "j < length tssb'"
	    assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	    show "𝒪j  read_only (𝒮sbW RA L) = {}"
	    proof (cases "i=j")
	      case True
	      from read_only_unowned [OF i_bound tssb_i] R_owned  A_R 
	      have "(𝒪sb  A - R)  read_only (𝒮sbW RA L) = {}"
		by (auto simp add: in_read_only_convs )
	      with jth tssb_i i_bound True
	      show ?thesis
		by (auto simp add: 𝒪sb' tssb')
	    next
	      case False
	      from j_bound have j_bound': "j < length tssb"
		by (auto simp add: tssb')
	      with False jth have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (auto simp add: tssb')
	      from read_only_unowned [OF j_bound' jth']
	      have "𝒪j  read_only 𝒮sb = {}".
	      moreover
	      from ownership_distinct [OF i_bound j_bound' False tssb_i jth'] R_owned
	      have "(𝒪sb  A)  𝒪j = {}"
		by (auto simp add: sb Writesb volatile)
	      moreover note R_owned A_R
	      ultimately show ?thesis
		by (fastforce simp add: in_read_only_convs split: if_split_asm)
	    qed
	  qed
	next
	  show "unowned_shared (𝒮sbW RA L) tssb'"
	  proof (unfold_locales)
	    show "- ((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set tssb')  dom (𝒮sbW RA L)"
	    proof -
	      
	      have s: "((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set tssb') =
              ((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set tssb)  A - R"
	      
		apply (unfold tssb' 𝒪sb') 
		apply (rule acquire_release_ownership_nth_update [OF R_owned i_bound tssb_i])
		apply (rule local.ownership_distinct_axioms)
		done
	      
	      note unowned_shared L_subset A_R
	      then
	      show ?thesis
		apply (simp only: s)
		apply auto
		done
	    qed
	  qed
	next
	  show "no_outstanding_write_to_read_only_memory (𝒮sbW RA L) tssb'"
	  proof 
	    fix j pj "isj" "𝒪j" j 𝒟j acqj xsj sbj
	    assume j_bound: "j < length tssb'"
	    assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	    show "no_write_to_read_only_memory (𝒮sbW RA L) sbj"
	    proof (cases "i=j")
	      case True
	      with jth tssb_i i_bound no_outstanding_write_to_read_only_memory [OF i_bound tssb_i]
	      show ?thesis
		by (auto simp add: sb tssb' Writesb volatile)
	    next
	      case False
	      from j_bound have j_bound': "j < length tssb"
		by (auto simp add: tssb')
	      with False jth have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (auto simp add: tssb')
	      from no_outstanding_write_to_read_only_memory [OF j_bound' jth']
	      have nw: "no_write_to_read_only_memory 𝒮sb sbj".
	      have "R  outstanding_refs is_Writesb sbj = {}"
	      proof -
		note dist = ownership_distinct [OF i_bound j_bound' False tssb_i jth']
		from non_volatile_owned_or_read_only_outstanding_non_volatile_writes 
		[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
		  dist
		have "outstanding_refs is_non_volatile_Writesb sbj  𝒪sb = {}"
		  by auto
		moreover
		from outstanding_volatile_writes_unowned_by_others [OF j_bound'  i_bound 
		  False [symmetric] jth' tssb_i ]
		have "outstanding_refs is_volatile_Writesb sbj  𝒪sb = {}" 
		  by auto
		ultimately have "outstanding_refs is_Writesb sbj  𝒪sb = {}" 
		  by (auto simp add: misc_outstanding_refs_convs)
		with R_owned
		show ?thesis by blast
	      qed
	      then
	      have "aoutstanding_refs is_Writesb sbj.
		a  read_only (𝒮sbW RA L)  a  read_only 𝒮sb"
		by (auto simp add: in_read_only_convs) 
	      
	      from no_write_to_read_only_memory_read_only_reads_eq [OF nw this]
	      show ?thesis .
	    qed
	  qed
	qed
	 
	from direct_memop_step.WriteVolatile [OF]
	have "(Write True a (D, f) A L R W# is',
	  , (), m,𝒟, acquired True ?take_sb 𝒪sb, release ?take_sb (dom 𝒮sb) sb,𝒮)  
          (is', , (), m (a := v),True, acquired True ?take_sb 𝒪sb  A - R, Map.empty,𝒮W RA L)"
	  by (simp add: f_v' [symmetric])
	  
	from direct_computation.Memop [OF i_bound' ts_i this]
	have store_step: 
	  "(ts, m, 𝒮) d (?ts', m(a := v),𝒮W RA L)".	

	have sb'_split: 
	  "sb' = takeWhile (Not  is_volatile_Writesb) sb' @ 
                    dropWhile (Not  is_volatile_Writesb) sb'"
	  by simp

	from reads_consis 
	have no_vol_reads: "outstanding_refs is_volatile_Readsb sb' = {}"
	  by (simp add: sb Writesb True)
	hence "outstanding_refs is_volatile_Readsb (takeWhile (Not  is_volatile_Writesb) sb') 
	  = {}"
	  by (auto simp add: outstanding_refs_conv dest: set_takeWhileD)
	moreover 
	have "outstanding_refs is_volatile_Writesb 
           (takeWhile (Not  is_volatile_Writesb) sb') = {}"
	proof -
	  have "r  set (takeWhile (Not  is_volatile_Writesb) sb'). ¬ (is_volatile_Writesb r)"
	    by (auto dest: set_takeWhileD)
	  thus ?thesis
	    by (simp add: outstanding_refs_conv)
	qed
	ultimately
	have no_volatile: 
	  "outstanding_refs is_volatile (takeWhile (Not  is_volatile_Writesb) sb') = {}"
	  by (auto simp add: outstanding_refs_conv is_volatile_split)

	moreover

	from no_vol_reads have "r  set sb'. ¬ is_volatile_Readsb r"
	  by (fastforce simp add: outstanding_refs_conv is_volatile_Readsb_def 
	    split: memref.splits)
	hence "r  set sb'. (Not  is_volatile_Writesb) r = (Not  is_volatile) r"
	  by (auto simp add: is_volatile_split)

	hence takeWhile_eq: "(takeWhile (Not  is_volatile_Writesb) sb') =
              (takeWhile (Not  is_volatile) sb')" 
	  apply -
	  apply (rule takeWhile_cong)
	  apply auto
	  done

	from leq
	have leq': "length tssb = length ?ts'"
	  by simp
	hence i_bound_ts': "i < length ?ts'" using i_bound by simp

	from  is'_sim
	have is'_sim_split: 
	  "instrs 
                (takeWhile (Not  is_volatile_Writesb) sb' @ 
                 dropWhile (Not  is_volatile_Writesb) sb') @ issb = 
              is' @ prog_instrs (takeWhile (Not  is_volatile_Writesb) sb' @ 
                                 dropWhile (Not  is_volatile_Writesb) sb')"
	  by (simp add: sb'_split [symmetric])

	from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮sb tssb
	i_bound tssb_i reads_consis]
	have "reads_consistent True (acquired True ?take_sb 𝒪sb) m (Writesb True a (D,f) v A L R W#sb')"
	  by (simp add: m sb Writesb volatile)

	hence "reads_consistent True (acquired True ?take_sb 𝒪sb  A - R) (m(a:=v)) sb'"
	  by simp
	from reads_consistent_takeWhile [OF this]
	have r_consis': "reads_consistent True (acquired True ?take_sb 𝒪sb  A - R) (m(a:=v)) 
	       (takeWhile (Not  is_volatile_Writesb) sb')".


	
	from last_prog have last_prog_sb': "last_prog psb sb' = psb"
	  by (simp add: sb Writesb )


	from valid_write_sops  [OF i_bound tssb_i]
	have "sop  write_sops sb'. valid_sop sop"
	  by (auto simp add: sb Writesb)
	hence valid_sop': "sopwrite_sops (takeWhile (Not  is_volatile_Writesb) sb').
	        valid_sop sop"
	  by (fastforce dest: set_takeWhileD simp add: in_write_sops_conv)

	from no_volatile
	have no_volatile_Readsb:
	  "outstanding_refs is_volatile_Readsb (takeWhile (Not  is_volatile_Writesb) sb') =
              {}"
	  by (auto simp add: outstanding_refs_conv is_volatile_Readsb_def split: memref.splits)
	from flush_store_buffer_append [OF i_bound_ts' is'_sim_split, simplified, 
	OF causal_program_history_sb' ts'_i refl last_prog_sb' r_consis' hist_consis' 
	  valid_sop' dist_sb' no_volatile_Readsb_volatile_reads_consistent [OF no_volatile_Readsb], 
	  where 𝒮="(𝒮W RA L)"]

	  
	obtain is'' where
	  is''_sim: "instrs (dropWhile (Not  is_volatile_Writesb) sb') @ issb =
                      is'' @ prog_instrs (dropWhile (Not  is_volatile_Writesb) sb')" and

          steps: "(?ts', m(a := v), 𝒮W RA L) d*
                   (ts[i := (last_prog (hd_prog psb (dropWhile (Not  is_volatile_Writesb) sb'))
                            (takeWhile (Not  is_volatile_Writesb) sb'),
                         is'',
                         θsb |` (dom θsb -
                                    read_tmps (dropWhile (Not  is_volatile_Writesb) sb')),
                         (), True, acquired True (takeWhile (Not  is_volatile_Writesb) sb')
                                (acquired True ?take_sb 𝒪sb  A - R),
                                release (takeWhile (Not  is_volatile_Writesb) sb')
                                   (dom (𝒮W RA L)) Map.empty)],
	           flush (takeWhile (Not  is_volatile_Writesb) sb') (m(a := v)),
                   share (takeWhile (Not  is_volatile_Writesb) sb') (𝒮W RA L))"


	  by (auto)

	note sim_flush = r_rtranclp_rtranclp [OF store_step steps]

	moreover
	note flush_commute =
	  flush_flush_all_until_volatile_write_Writesb_volatile_commute [OF i_bound tssb_i [simplified sb Writesb True] 
	outstanding_refs_is_Writesb_takeWhile_disj a_notin_others']

	from last_prog_hd_prog_append' [where sb="(takeWhile (Not  is_volatile_Writesb) sb')"
          and sb'="(dropWhile (Not  is_volatile_Writesb) sb')",
	  simplified sb'_split [symmetric], OF hist_consis' last_prog_sb']
	have last_prog_eq: 
	  "last_prog (hd_prog psb (dropWhile (Not  is_volatile_Writesb) sb'))
                 (takeWhile (Not  is_volatile_Writesb) sb') =
              hd_prog psb (dropWhile (Not  is_volatile_Writesb) sb')".

	have take_emtpy: "takeWhile (Not  is_volatile_Writesb) (r#sb) = []"
	  by (simp add: Writesb True)


        have dist_sb': "i p is 𝒪  𝒟 θ sb.
          i < length tssb 
          tssb ! i = (p, is, θ, sb, 𝒟, 𝒪, ) 
          (all_shared (takeWhile (Not  is_volatile_Writesb) sb) 
          all_unshared (takeWhile (Not  is_volatile_Writesb) sb) 
          all_acquired (takeWhile (Not  is_volatile_Writesb) sb)) 
          (all_shared (takeWhile (Not  is_volatile_Writesb) sb') 
          all_unshared (takeWhile (Not  is_volatile_Writesb) sb') 
          all_acquired (takeWhile (Not  is_volatile_Writesb) sb')) =
          {}"
        proof -
          {
            fix j pj isj 𝒪j j 𝒟j θj sbj x
	    assume j_bound: "j < length tssb"
	    assume jth: "tssb!j = (pj,isj, θj,sbj,𝒟j,𝒪j,j)"
	    assume x_shared: "x  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)  
                                 all_unshared (takeWhile (Not  is_volatile_Writesb) sbj)  
                                 all_acquired (takeWhile (Not  is_volatile_Writesb) sbj)"
            assume x_sb': "x  (all_shared (takeWhile (Not  is_volatile_Writesb) sb') 
                        all_unshared (takeWhile (Not  is_volatile_Writesb) sb') 
                        all_acquired (takeWhile (Not  is_volatile_Writesb) sb'))"
            have False
            proof (cases "i=j")
              case True with x_shared tssb_i jth show False by (simp add: sb volatile Writesb)
            next
              case False
              from x_shared all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
                unshared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
                all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
		"(dropWhile (Not  is_volatile_Writesb) sbj)"]
                all_unshared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
		"(dropWhile (Not  is_volatile_Writesb) sbj)"]
                all_acquired_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
		"(dropWhile (Not  is_volatile_Writesb) sbj)"]
              have "x  all_acquired sbj  𝒪j "
                by auto
              moreover
              from x_sb' all_shared_acquired_or_owned [OF sharing_consis [OF i_bound tssb_i]]
                unshared_acquired_or_owned [OF sharing_consis [OF i_bound tssb_i]]
                all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sb')" 
		"(dropWhile (Not  is_volatile_Writesb) sb')"]
                all_unshared_append [of "(takeWhile (Not  is_volatile_Writesb) sb')" 
		"(dropWhile (Not  is_volatile_Writesb) sb')"]
                all_acquired_append [of "(takeWhile (Not  is_volatile_Writesb) sb')" 
		"(dropWhile (Not  is_volatile_Writesb) sb')"]
              have "x  all_acquired sb  𝒪sb"
                by (auto simp add: sb Writesb volatile)
              moreover
              note ownership_distinct [OF i_bound j_bound False tssb_i jth]
              ultimately show False by blast
            qed
          }
          thus ?thesis by blast
        qed

        have dist_R_L_A: "j p is 𝒪  𝒟 θ sb.
          j < length tssb  i j
          tssb ! j = (p, is, θ, sb, 𝒟, 𝒪, ) 
          (all_shared sb  all_unshared sb  all_acquired sb)  (R  L  A) = {}"
        proof -
          {
            fix j pj isj 𝒪j j 𝒟j θj sbj x
	    assume j_bound: "j < length tssb"
            assume neq_i_j: "i  j"
	    assume jth: "tssb!j = (pj,isj, θj,sbj,𝒟j,𝒪j,j)"
	    assume x_shared: "x  all_shared sbj  
                                 all_unshared sbj  
                                 all_acquired  sbj"
            assume x_R_L_A: "x  R  L  A"
            have False
            proof -
              from x_shared all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
                unshared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]

              have "x  all_acquired sbj  𝒪j "
                by auto
              moreover
              from x_R_L_A R_owned L_subset
              have "x  all_acquired sb  𝒪sb"
                by (auto simp add: sb Writesb volatile)
              moreover
              note ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth]
              ultimately show False by blast
            qed
          }
          thus ?thesis by blast
        qed
        from local.ownership_distinct_axioms have "ownership_distinct tssb" .
        from local.sharing_consis_axioms have "sharing_consis 𝒮sb tssb".
        note share_commute=
          share_all_until_volatile_write_flush_commute [OF take_empty ‹ownership_distinct tssb ‹sharing_consis 𝒮sb tssb i_bound tssb_i dist_sb' dist_R_L_A]
        
        have rel_commute_empty:
          "release (takeWhile (Not  is_volatile_Writesb) sb') (dom 𝒮  R - L) Map.empty =
                 release (takeWhile (Not  is_volatile_Writesb) sb') (dom 𝒮sb  R - L) Map.empty"
        proof -
          {
            fix a
            assume a_in: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sb')"
            have "(a  (dom 𝒮  R - L)) = (a  (dom 𝒮sb  R - L))"
            proof -
              
              from all_shared_acquired_or_owned [OF sharing_consis [OF i_bound tssb_i]] a_in
                all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sb')" "(dropWhile (Not  is_volatile_Writesb) sb')"]
              have "a  𝒪sb  all_acquired sb  " 
                by (auto simp add: sb Writesb volatile)
              from share_all_until_volatile_write_thread_local [OF ‹ownership_distinct tssb ‹sharing_consis 𝒮sb tssb i_bound tssb_i this]
              have "𝒮 a = 𝒮sb a"
                by (auto simp add: sb Writesb volatile 𝒮)
              then show ?thesis
                by (auto simp add: domIff)
            qed
          }
          then show ?thesis
            apply -
            apply (rule release_all_shared_exchange)
            apply auto
            done
        qed
          
        {
	  fix j pj isj 𝒪j j 𝒟j θj sbj x
	  assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	  assume j_bound: "j < length tssb"
          assume neq: "i  j" 
          have "release (takeWhile (Not  is_volatile_Writesb) sbj)
                            (dom 𝒮sb  R - L) j
              = release (takeWhile (Not  is_volatile_Writesb) sbj)
                            (dom 𝒮sb) j"
          proof -
            {
              fix a
              assume a_in: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)"
              have "(a  (dom 𝒮sb  R - L)) = (a  dom 𝒮sb)"
              proof -
                from ownership_distinct [OF i_bound j_bound neq  tssb_i jth]
                
                have A_dist: "A  (𝒪j  all_acquired sbj) = {}"
                  by (auto simp add: sb Writesb volatile)
              
                from  all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]] a_in
                  all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
                  "(dropWhile (Not  is_volatile_Writesb) sbj)"]
                have a_in: "a  𝒪j  all_acquired sbj"
                  by auto
                with ownership_distinct [OF i_bound j_bound neq  tssb_i jth]
                have "a  (𝒪sb  all_acquired sb)" by auto

              
                with A_dist R_owned A_R A_shared_owned L_subset a_in
                obtain "a  R" and "a  L"
                  by fastforce
                then show ?thesis by auto
              qed
            }
            then 
            show ?thesis 
              apply -
              apply (rule release_all_shared_exchange)
              apply auto
              done
          qed
        }
        note release_commute = this
	  
have "(tssb [i := (psb,issb, θsb, sb', 𝒟sb, 𝒪sb  A - R,Map.empty)],msb(a:=v),𝒮sb')  
	      (ts[i := (last_prog (hd_prog psb (dropWhile (Not  is_volatile_Writesb) sb'))
                            (takeWhile (Not  is_volatile_Writesb) sb'),
                         is'',
                         θsb |` (dom θsb -
                                    read_tmps (dropWhile (Not  is_volatile_Writesb) sb')),
                         (),True, acquired True (takeWhile (Not  is_volatile_Writesb) sb')
                                (acquired True ?take_sb 𝒪sb  A - R),
                             release (takeWhile (Not  is_volatile_Writesb) sb')
                                   (dom (𝒮W RA L)) Map.empty)],
               flush (takeWhile (Not  is_volatile_Writesb) sb') (m(a := v)),
               share (takeWhile (Not  is_volatile_Writesb) sb') (𝒮W RA L))"
	  apply (rule sim_config.intros) 
	  apply    (simp add: flush_commute m)
	  apply   (clarsimp simp add: 𝒮sb' 𝒮 share_commute simp del: restrict_restrict)
	  using  leq
	  apply  simp
	  using i_bound i_bound' ts_sim 𝒟
	  apply (clarsimp simp add: Let_def nth_list_update is''_sim last_prog_eq sb Writesb volatile  𝒮sb'
            rel_commute_empty
	     split: if_split_asm )
          apply (rule conjI)
          apply  blast
          apply clarsimp
          apply (frule (2) release_commute)
          apply clarsimp
          apply fastforce
	  done

	ultimately
	show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' 
	   valid_dd' valid_sops' load_tmps_fresh' enough_flushs' 
	   valid_program_history' valid'
	    msb' 𝒮sb' tssb' 
	  by (auto simp del: fun_upd_apply simp add: 𝒪sb' ℛsb' )

      next

	case False
	note non_vol = this
	
	from flush Writesb False
	obtain 
	  𝒪sb': "𝒪sb'=𝒪sb" and
	  𝒮sb': "𝒮sb'=𝒮sb" andsb': "sb' = sb"
	  by cases (auto  simp add: sb)


	from non_volatile_owned non_vol have a_owned: "a  𝒪sb"
	  by simp

	{
	  fix j 
	  fix pj issbj 𝒪j 𝒟sbj θj j sbj
	  assume j_bound: "j < length tssb"
	  assume tssb_j: "tssb!j=(pj,issbj,θj,sbj,𝒟sbj,𝒪j,j)"
	  assume neq_i_j: "ij"
	  have "a  unforwarded_non_volatile_reads (dropWhile (Not  is_volatile_Writesb) sbj) {}"
	  proof 
	    let ?take_sbj = "takeWhile (Not  is_volatile_Writesb) sbj"
	    let ?drop_sbj = "dropWhile (Not  is_volatile_Writesb) sbj"
	    assume a_in: "a   unforwarded_non_volatile_reads ?drop_sbj {}"
	    
	    from a_unowned_by_others [rule_format, OF j_bound neq_i_j] tssb_j 
	    obtain a_unowned: "a  𝒪j" and a_unacq: "a  all_acquired sbj"
	      by auto
	    with all_acquired_append [of ?take_sbj ?drop_sbj] acquired_takeWhile_non_volatile_Writesb [of sbj 𝒪j]
	    have a_unacq_take: "a  acquired True ?take_sbj 𝒪j"
	      by (auto )

	    note nvo_j = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound tssb_j]
	  
	    from non_volatile_owned_or_read_only_drop [OF nvo_j]
	    have nvo_drop_j: "non_volatile_owned_or_read_only True (share ?take_sbj 𝒮sb)
	      (acquired True ?take_sbj 𝒪j) ?drop_sbj" .
	    from in_unforwarded_non_volatile_reads_non_volatile_Readsb [OF a_in]
	    have a_in': "a  outstanding_refs is_non_volatile_Readsb ?drop_sbj".

	    from non_volatile_owned_or_read_only_outstanding_refs [OF nvo_drop_j] a_in'
	    have "a  acquired True ?take_sbj 𝒪j  all_acquired ?drop_sbj   
	      read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	      by (auto simp add: misc_outstanding_refs_convs)
	    
	    moreover 
	    from acquired_append [of True ?take_sbj ?drop_sbj 𝒪j] acquired_all_acquired [of True ?take_sbj 𝒪j]
	      all_acquired_append [of ?take_sbj ?drop_sbj]
	    have "acquired True ?take_sbj 𝒪j  all_acquired ?drop_sbj  𝒪j  all_acquired sbj"
	      by auto
	    ultimately 
	    have "a  read_only_reads (acquired True ?take_sbj 𝒪j) ?drop_sbj"
	      using a_owned ownership_distinct [OF i_bound j_bound neq_i_j tssb_i tssb_j]
	      by auto
	    
	    with read_only_reads_unowned [OF j_bound i_bound neq_i_j [symmetric] tssb_j tssb_i] a_owned
	    show False
	      by auto
	  qed
	} note a_notin_unforwarded_non_volatile_reads_drop = this
	    

	(* FIXME: the same proof as in volatile, case. depends on a_notin_unforwarded_non_volatile_reads_drop *)
	have valid_reads': "valid_reads msb' tssb'"
	proof (unfold_locales)
	  fix j pj "isj" 𝒪j j 𝒟j θj sbj
	  assume j_bound: "j < length tssb'"
	  assume ts_j: "tssb'!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	  show "reads_consistent False 𝒪j msb' sbj"
	  proof (cases "i=j")
	    case True
	    from reads_consis ts_j j_bound sb show ?thesis
	      by (clarsimp simp add: True  msb' Writesb tssb' 𝒪sb' False reads_consistent_pending_write_antimono)
	  next
	    case False
	    from j_bound have j_bound':  "j < length tssb"
	      by (simp add: tssb')
	    moreover from ts_j False have ts_j': "tssb ! j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	      using j_bound by (simp add: tssb')
	    ultimately have consis_m: "reads_consistent False 𝒪j msb sbj"
	      by (rule valid_reads)
	    from a_unowned_by_others [rule_format, OF j_bound' False] ts_j'
	    have a_unowned:"a  𝒪j  all_acquired sbj"
	      by simp

	    let ?take_sbj = "takeWhile (Not  is_volatile_Writesb) sbj"
	    let ?drop_sbj = "dropWhile (Not  is_volatile_Writesb) sbj"

	    from a_unowned acquired_reads_all_acquired [of True ?take_sbj 𝒪j]
	    all_acquired_append [of ?take_sbj ?drop_sbj]
	    have a_not_acq_reads: "a  acquired_reads True ?take_sbj 𝒪j"
	      by auto
	    moreover
	    
	    note a_unfw= a_notin_unforwarded_non_volatile_reads_drop [OF j_bound' ts_j' False]
	    ultimately
	    show ?thesis
	      using reads_consistent_mem_eq_on_unforwarded_non_volatile_reads_drop [where W="{}" and 
		A="unforwarded_non_volatile_reads ?drop_sbj {}  acquired_reads True ?take_sbj 𝒪j" and
		m'= "(msb(a:=v))", OF _ _ _ consis_m]
	      by (fastforce simp add: msb')
	  qed
	qed

	have valid_own': "valid_ownership 𝒮sb' tssb'"
	proof (intro_locales)
	  show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	  proof -
	    from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i] sb
	    have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb sb'"
	      by (auto simp add: Writesb False)
	    from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	    show ?thesis by (simp add: tssb' Writesb False 𝒪sb' 𝒮sb')
	  qed
	next
	  show "outstanding_volatile_writes_unowned_by_others tssb'"
	  proof -
	    from sb 
	    have out: "outstanding_refs is_volatile_Writesb sb'  outstanding_refs is_volatile_Writesb sb"
	      by (auto simp add: Writesb False)
	    have acq: "all_acquired sb'  all_acquired sb"
	      by (auto simp add: Writesb False sb)
	    from outstanding_volatile_writes_unowned_by_others_store_buffer 
	    [OF i_bound tssb_i out acq]
	    show ?thesis by (simp add: tssb' Writesb False 𝒪sb')
	  qed
	next
	  show "read_only_reads_unowned tssb'"
	  proof -
	    have ro: "read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb') 𝒪sb)
	      (dropWhile (Not  is_volatile_Writesb) sb')
	       read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪sb)
	      (dropWhile (Not  is_volatile_Writesb) sb)"
	      by (auto simp add: sb Writesb non_vol)
	    have "𝒪sb  all_acquired sb'  𝒪sb  all_acquired sb"
	      by (auto simp add: sb Writesb non_vol)
	    from read_only_reads_unowned_nth_update [OF i_bound tssb_i ro this] 
	    show ?thesis
	      by (simp add: tssb' sb 𝒪sb')
	  qed
	next
	  show "ownership_distinct tssb'"
	  proof -
	    have acq: "all_acquired sb'  all_acquired sb"
	      by (auto simp add: Writesb False sb)
	    with ownership_distinct_instructions_read_value_store_buffer_independent 
	    [OF i_bound tssb_i]
	    show ?thesis by (simp add: tssb' Writesb False 𝒪sb')
	  qed
	qed

	have valid_sharing': "valid_sharing 𝒮sb' tssb'"
	proof (intro_locales)	
	  from outstanding_non_volatile_writes_unshared [OF i_bound tssb_i]
	  have "non_volatile_writes_unshared 𝒮sb sb'"
	    by (auto simp add: sb Writesb False)
	  from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
	  show "outstanding_non_volatile_writes_unshared 𝒮sb' tssb'"
	    by (simp add: tssb' 𝒮sb')
	next
	  from sharing_consis [OF i_bound tssb_i]
	  have "sharing_consistent 𝒮sb 𝒪sb sb'"
	    by (auto simp add: sb Writesb False)
	  from sharing_consis_nth_update [OF i_bound this]
	  show "sharing_consis 𝒮sb' tssb'"
	    by (simp add: tssb' 𝒪sb' 𝒮sb')
	next
	  from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound tssb_i] ]
	  show "read_only_unowned 𝒮sb' tssb'"
	    by (simp add: 𝒮sb' tssb' 𝒪sb')
	next
	  from unowned_shared_nth_update [OF i_bound tssb_i subset_refl]
	  show "unowned_shared 𝒮sb' tssb'"
	    by (simp add: tssb' 𝒪sb' 𝒮sb')
	next
	  from no_outstanding_write_to_read_only_memory [OF i_bound tssb_i] 
	  have "no_write_to_read_only_memory 𝒮sb sb'"
	    by (auto simp add: sb Writesb False)
	  from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
	  show "no_outstanding_write_to_read_only_memory 𝒮sb' tssb'"
	    by (simp add: 𝒮sb' tssb' sb)
	qed

	from is_sim
	obtain is_sim: "instrs (dropWhile (Not  is_volatile_Writesb) sb') @ issb =
                 is @ prog_instrs (dropWhile (Not  is_volatile_Writesb) sb')"
	  by (simp add: suspends sb Writesb False)

	have "(ts,m,𝒮) d* (ts,m,𝒮)" by blast

	moreover


	note flush_commute =
	  flush_all_until_volatile_write_Writesb_non_volatile_commute [OF i_bound tssb_i [simplified sb Writesb non_vol] 
	outstanding_refs_is_Writesb_takeWhile_disj a_notin_others']

	note share_commute = 
	  share_all_until_volatile_write_update_sb [of sb' sb, OF _ i_bound tssb_i, simplified sb Writesb False, simplified]
	have "(tssb [i := (psb,issb,θsb, sb', 𝒟sb, 𝒪sb,sb)], msb(a:=v),𝒮sb')  
                (ts,m,𝒮)"
	  apply (rule sim_config.intros) 
	  apply    (simp add: m flush_commute)
	  apply   (clarsimp simp add: 𝒮 𝒮sb' share_commute)
	  using  leq
	  apply  simp
	  using i_bound i_bound' is_sim ts_i ts_sim 𝒟 
	  apply (clarsimp simp add: Let_def nth_list_update suspends sb Writesb False 𝒮sb'
	     split: if_split_asm )
	  done	

	ultimately
	show ?thesis
	  using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' msb'
	   valid_dd' valid_sops' load_tmps_fresh' enough_flushs' valid_program_history' valid'
	    tssb' 𝒪sb' 𝒮sb' ℛsb'
	  by (auto simp del: fun_upd_apply)
      qed
    next
      case (Readsb volatile a t v)
      from flush this obtain msb': "msb'=msb" and 
	𝒪sb': "𝒪sb'=𝒪sb" and 𝒮sb': "𝒮sb'=𝒮sb" andsb': "sb'=sb"
	by cases (auto simp add: sb)

      have valid_own': "valid_ownership 𝒮sb' tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	proof -
	  from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i] sb
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb sb'"
	    by (auto simp add: Readsb)
	  from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	  show ?thesis by (simp add: tssb' Readsb 𝒪sb' 𝒮sb')
	qed
      next
	show "outstanding_volatile_writes_unowned_by_others tssb'"
	proof -
	  from sb 
	  have out: "outstanding_refs is_volatile_Writesb sb'  outstanding_refs is_volatile_Writesb sb"
	    by (auto simp add: Readsb)
	  have acq: "all_acquired sb'  all_acquired sb"
	    by (auto simp add: Readsb sb)
	  from outstanding_volatile_writes_unowned_by_others_store_buffer 
	  [OF i_bound tssb_i out acq]
	  show ?thesis by (simp add: tssb' Readsb 𝒪sb')
	qed
      next
	show "read_only_reads_unowned tssb'"
	proof -
	  have ro: "read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb') 𝒪sb)
	    (dropWhile (Not  is_volatile_Writesb) sb')
	     read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪sb)
	    (dropWhile (Not  is_volatile_Writesb) sb)"
	    by (auto simp add: sb Readsb)
	  have "𝒪sb  all_acquired sb'  𝒪sb  all_acquired sb"
	    by (auto simp add: sb Readsb)
	  from read_only_reads_unowned_nth_update [OF i_bound tssb_i ro this] 
	  show ?thesis
	    by (simp add: tssb' sb 𝒪sb')
	qed
      next
	show "ownership_distinct tssb'"
	proof -
	  have acq: "all_acquired sb'  all_acquired sb"
	    by (auto simp add: Readsb sb)
	  with ownership_distinct_instructions_read_value_store_buffer_independent 
	  [OF i_bound tssb_i]
	  show ?thesis by (simp add: tssb' Readsb 𝒪sb')
	qed
      qed

      have valid_sharing': "valid_sharing 𝒮sb' tssb'"
      proof (intro_locales)	
	from outstanding_non_volatile_writes_unshared [OF i_bound tssb_i]
	have "non_volatile_writes_unshared 𝒮sb sb'"
	  by (auto simp add: sb Readsb)
	from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
	show "outstanding_non_volatile_writes_unshared 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒮sb')
      next
	from sharing_consis [OF i_bound tssb_i]
	have "sharing_consistent 𝒮sb 𝒪sb sb'"
	  by (auto simp add: sb Readsb)
	from sharing_consis_nth_update [OF i_bound this]
	show "sharing_consis 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒪sb' 𝒮sb')
      next
	from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound tssb_i] ]
	show "read_only_unowned 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' 𝒪sb')
      next
	from unowned_shared_nth_update [OF i_bound tssb_i subset_refl]
	show "unowned_shared 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒪sb' 𝒮sb')
      next
	from no_outstanding_write_to_read_only_memory [OF i_bound tssb_i] 
	have "no_write_to_read_only_memory 𝒮sb sb'"
	  by (auto simp add: sb Readsb)
	from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
	show "no_outstanding_write_to_read_only_memory 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' sb)
      qed	

      have valid_reads': "valid_reads msb' tssb'"
      proof -
	from valid_reads [OF i_bound tssb_i]
	have "reads_consistent False 𝒪sb msb sb'"
	  by (simp add: sb Readsb)
	from valid_reads_nth_update [OF i_bound this]
	show ?thesis by (simp add: msb' tssb' 𝒪sb')
      qed

      have valid_program_history': "valid_program_history tssb'"
      proof -	
	from valid_program_history [OF i_bound tssb_i]
	have "causal_program_history issb sb" .
	then have causal': "causal_program_history issb sb'"
	  by (simp add: sb Readsb causal_program_history_def)

	from valid_last_prog [OF i_bound tssb_i]
	have "last_prog psb sb = psb".
	hence "last_prog psb sb' = psb"
	  by (simp add: sb Readsb)

	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb')
      qed

      from is_sim
      have is_sim: "instrs (dropWhile (Not  is_volatile_Writesb) sb') @ issb =
	         is @ prog_instrs (dropWhile (Not  is_volatile_Writesb) sb')"
	by (simp add: sb Readsb suspends)

      from valid_history [OF i_bound tssb_i]
      have θsb_v: "θsb t = Some v"
	by (simp add: history_consistent_access_last_read sb Readsb split:option.splits)

      have "(ts,m,𝒮) d* (ts,m,𝒮)" by blast

      moreover

      note flush_commute= flush_all_until_volatile_write_Readsb_commute [OF i_bound tssb_i [simplified sb Readsb]]
 
      note share_commute = 
	  share_all_until_volatile_write_update_sb [of sb' sb, OF _ i_bound tssb_i, simplified sb Readsb, simplified]
      have "(tssb [i := (psb,issb, θsb, sb',𝒟sb, 𝒪sb,sb')],msb,𝒮sb')  (ts,m,𝒮)"
	apply (rule sim_config.intros) 
	apply    (simp add: m flush_commute)
	apply   (clarsimp simp add: 𝒮 𝒮sb' share_commute)
	using  leq
	apply  simp
	
	using i_bound i_bound' ts_sim ts_i is_sim 𝒟
	apply (clarsimp simp add: Let_def nth_list_update sb suspends Readsb 𝒮sb' ℛsb'
	   split: if_split_asm)
	done	

      ultimately show ?thesis
	using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' msb'
	  valid_dd' valid_sops' load_tmps_fresh' enough_flushs' valid_sharing' 
	  valid_program_history' valid'
	  tssb' 𝒪sb' 𝒮sb' 
	by (auto simp del: fun_upd_apply)
    next
      case (Progsb p1 p2 mis)
      from flush this obtain msb': "msb'=msb" and 
	𝒪sb': "𝒪sb'=𝒪sb" and 𝒮sb': "𝒮sb'=𝒮sb" andsb': "sb'=sb"
	by cases (auto simp add: sb)

      have valid_own': "valid_ownership 𝒮sb' tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	proof -
	  from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i] sb
	  have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb sb'"
	    by (auto simp add: Progsb)
	  from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	  show ?thesis by (simp add: tssb' Progsb 𝒪sb' 𝒮sb')
	qed
      next
	show "outstanding_volatile_writes_unowned_by_others tssb'"
	proof -
	  from sb 
	  have out: "outstanding_refs is_volatile_Writesb sb'  outstanding_refs is_volatile_Writesb sb"
	    by (auto simp add: Progsb)
	  have acq: "all_acquired sb'  all_acquired sb"
	    by (auto simp add: Progsb sb)
	  from outstanding_volatile_writes_unowned_by_others_store_buffer 
	  [OF i_bound tssb_i out acq]
	  show ?thesis by (simp add: tssb' Progsb 𝒪sb')
	qed
      next
	show "read_only_reads_unowned tssb'"
	proof -
	  have ro: "read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb') 𝒪sb)
	    (dropWhile (Not  is_volatile_Writesb) sb')
	       read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪sb)
	    (dropWhile (Not  is_volatile_Writesb) sb)"
	    by (auto simp add: sb Progsb)
	  have "𝒪sb  all_acquired sb'  𝒪sb  all_acquired sb"
	    by (auto simp add: sb Progsb)
	  from read_only_reads_unowned_nth_update [OF i_bound tssb_i ro this] 
	  show ?thesis
	    by (simp add: tssb' sb 𝒪sb')
	qed
      next
	  show "ownership_distinct tssb'"
	  proof -
	  have acq: "all_acquired sb'  all_acquired sb"
	    by (auto simp add: Progsb sb)
	  with ownership_distinct_instructions_read_value_store_buffer_independent 
	  [OF i_bound tssb_i]
	  show ?thesis by (simp add: tssb' Progsb 𝒪sb')
	qed
      qed

      have valid_sharing': "valid_sharing 𝒮sb' tssb'"
      proof (intro_locales)	
	from outstanding_non_volatile_writes_unshared [OF i_bound tssb_i]
	have "non_volatile_writes_unshared 𝒮sb sb'"
	  by (auto simp add: sb Progsb)
	from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
	show "outstanding_non_volatile_writes_unshared 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒮sb')
      next
	from sharing_consis [OF i_bound tssb_i]
	have "sharing_consistent 𝒮sb 𝒪sb sb'"
	  by (auto simp add: sb Progsb)
	from sharing_consis_nth_update [OF i_bound this]
	show "sharing_consis 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒪sb' 𝒮sb')
      next
	from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound tssb_i] ]
	show "read_only_unowned 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' 𝒪sb')
      next
	from unowned_shared_nth_update [OF i_bound tssb_i subset_refl]
	show "unowned_shared 𝒮sb' tssb'"
	  by (simp add: tssb' 𝒪sb' 𝒮sb')
      next
	from no_outstanding_write_to_read_only_memory [OF i_bound tssb_i] 
	have "no_write_to_read_only_memory 𝒮sb sb'"
	  by (auto simp add: sb Progsb)
	from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
	show "no_outstanding_write_to_read_only_memory 𝒮sb' tssb'"
	  by (simp add: 𝒮sb' tssb' sb)
      qed
      
      have valid_reads': "valid_reads msb' tssb'"
      proof -
	from valid_reads [OF i_bound tssb_i]
	have "reads_consistent False 𝒪sb msb sb'"
	  by (simp add: sb Progsb)
	from valid_reads_nth_update [OF i_bound this]
	show ?thesis by (simp add: msb' tssb' 𝒪sb')
      qed

      have valid_program_history': "valid_program_history tssb'"
      proof -	
	from valid_program_history [OF i_bound tssb_i]
	have "causal_program_history issb sb" .
	then have causal': "causal_program_history issb sb'"
	  by (simp add: sb Progsb causal_program_history_def)

	from valid_last_prog [OF i_bound tssb_i]
	have "last_prog psb sb = psb".
	hence "last_prog p2 sb' = psb"
	  by (simp add: sb Progsb)
	from last_prog_to_last_prog_same [OF this]
	have "last_prog psb sb' = psb".

	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb')
      qed

      from is_sim
      have is_sim: "instrs (dropWhile (Not  is_volatile_Writesb) sb') @ issb =
	is @ prog_instrs (dropWhile (Not  is_volatile_Writesb) sb')"
	by (simp add: suspends sb Progsb)

      have "(ts,m,𝒮) d* (ts,m,𝒮)" by blast

      moreover

      note flush_commute = flush_all_until_volatile_write_Progsb_commute [OF i_bound 
	tssb_i [simplified sb Progsb]]

      note share_commute = 
	  share_all_until_volatile_write_update_sb [of sb' sb, OF _ i_bound tssb_i, simplified sb Progsb, simplified]

      have "(tssb [i := (psb,issb, θsb, sb',𝒟sb, 𝒪sb,sb)],msb,𝒮sb')  (ts,m,𝒮)"
	apply (rule sim_config.intros) 
	apply    (simp add: m flush_commute)
	apply   (clarsimp simp add: 𝒮 𝒮sb' share_commute)
	using  leq
	apply  simp
	
	using i_bound i_bound' ts_sim ts_i is_sim 𝒟
	apply (clarsimp simp add: Let_def nth_list_update sb suspends Progsbsb' 𝒮sb'
	   split: if_split_asm)
	done	
      ultimately show ?thesis
	using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' msb'
	  valid_dd' valid_sops' load_tmps_fresh' enough_flushs' valid_sharing' 
	  valid_program_history' valid' 
	  tssb' 𝒮sb' 𝒪sb' ℛsb' 𝒮sb'
	by (auto simp del: fun_upd_apply)
    next
      case (Ghostsb A L R W)
      from flush Ghostsb
      obtain 
	𝒪sb': "𝒪sb'=𝒪sb  A - R" and
	𝒮sb': "𝒮sb'=𝒮sbW RA L" andsb': "sb'= augment_rels (dom 𝒮sb) R sb" and
	msb': "msb'=msb" 
	by cases (auto simp add: sb)

      from sharing_consis [OF i_bound tssb_i] 
      obtain 
	A_shared_owned: "A  dom 𝒮sb  𝒪sb" and
	L_subset: "L  A" and
	A_R: "A  R = {}" and
	R_owned: "R  𝒪sb"
	by (clarsimp simp add: sb Ghostsb)

      have valid_own': "valid_ownership 𝒮sb' tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
	proof 
	  fix j isj 𝒪j j 𝒟j acqj θj sbj pj
	  assume j_bound: "j < length tssb'"
	  assume tssb'_j: "tssb'!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	  show "non_volatile_owned_or_read_only False 𝒮sb' 𝒪j sbj"
	  proof (cases "j=i")
	    case True
	    from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i]
	    have "non_volatile_owned_or_read_only False (𝒮sbW RA L) (𝒪sb  A - R) sb'"
	      by (auto simp add: sb Ghostsb non_volatile_owned_or_read_only_pending_write_antimono)
	    then show ?thesis
	      using True i_bound tssb'_j
	      by (auto simp add: tssb' 𝒮sb' sb 𝒪sb')
	  next
	    case False
	    from j_bound have j_bound': "j < length tssb"
	      by (auto simp add: tssb')
	    with tssb'_j False i_bound 
	    have tssb_j: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	      by (auto simp add: tssb')
	      
	      
	    note nvo = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' tssb_j]

	    from read_only_unowned [OF i_bound tssb_i] R_owned
	    have "R  read_only 𝒮sb = {}"
	      by auto

	    with read_only_reads_unowned [OF j_bound' i_bound False tssb_j tssb_i] L_subset
	    have "aread_only_reads
	      (acquired True (takeWhile (Not  is_volatile_Writesb) sbj) 𝒪j)
		(dropWhile (Not  is_volatile_Writesb) sbj).
		a  read_only 𝒮sb  a  read_only (𝒮sbW RA L )"
	      by (auto simp add: in_read_only_convs sb Ghostsb)
	    from non_volatile_owned_or_read_only_read_only_reads_eq' [OF nvo this]
	    have "non_volatile_owned_or_read_only False (𝒮sbW RA L) 𝒪j sbj".
	    thus ?thesis by (simp add: 𝒮sb')
	  qed
	qed
      next
	show "outstanding_volatile_writes_unowned_by_others tssb'"
	proof (unfold_locales)
	  fix i1 j p1 "is1" 𝒪1 1 𝒟1 xs1 sb1 pj "isj" "𝒪j" j 𝒟j xsj sbj
	  assume i1_bound: "i1 < length tssb'"
	  assume j_bound: "j < length tssb'"
	  assume i1_j: "i1  j"
	  assume ts_i1: "tssb'!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	  assume ts_j: "tssb'!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb1 = {}"
	  proof (cases "i1=i")
	    case True
	    from i1_j True have neq_i_j: "ij"
	      by auto
	    from j_bound have j_bound': "j < length tssb"
	      by (simp add: tssb')
	    from ts_j neq_i_j have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (simp add: tssb')
	    from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound' neq_i_j
	      tssb_i ts_j'] ts_i1 i_bound tssb_i True show ?thesis
	      by (clarsimp simp add: tssb' sb Ghostsb)
	  next
	    case False
	    note i1_i = this
	    from i1_bound have i1_bound': "i1 < length tssb"
	      by (simp add: tssb' sb)
	    hence i1_bound'': "i1 < length (map owned tssb)"
	      by auto
	    from ts_i1 False have ts_i1': "tssb!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	      by (simp add: tssb' sb)
	    show ?thesis
	    proof (cases "j=i")
	      case True
	      from outstanding_volatile_writes_unowned_by_others [OF i1_bound' i_bound  i1_i  ts_i1' tssb_i ]
	      have "(𝒪sb  all_acquired sb)  outstanding_refs is_volatile_Writesb sb1 = {}".
	      then show ?thesis
		using True i1_i ts_j tssb_i i_bound
		by (auto simp add: sb Ghostsb tssb' 𝒪sb')
	    next
	      case False
	      from j_bound have j_bound': "j < length tssb"
		by (simp add: tssb')
	      from ts_j False have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (simp add: tssb')
	      from outstanding_volatile_writes_unowned_by_others 
	      [OF i1_bound' j_bound' i1_j ts_i1' ts_j']
	      show "(𝒪j  all_acquired sbj)  outstanding_refs is_volatile_Writesb sb1 = {}" .
	    qed
	  qed
	qed
      next
	show "read_only_reads_unowned tssb'"
	proof 
	  fix n m
	  fix pn "isn" 𝒪n n 𝒟n θn sbn pm "ism" 𝒪m m 𝒟m θm sbm
	  assume n_bound: "n < length tssb'"
	    and m_bound: "m < length tssb'"
	    and neq_n_m: "nm"
	    and nth: "tssb'!n = (pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
	    and mth: "tssb'!m =(pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
	  from n_bound have n_bound': "n < length tssb" by (simp add: tssb')
	  from m_bound have m_bound': "m < length tssb" by (simp add: tssb')
	  show "(𝒪m  all_acquired sbm) 
            read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sbn) 𝒪n)
            (dropWhile (Not  is_volatile_Writesb) sbn) =
            {}"
	  proof (cases "m=i")
	    case True
	    with neq_n_m have neq_n_i: "ni"
	      by auto
	    
	    with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
	      by (auto simp add: tssb')
	    note read_only_reads_unowned [OF n_bound' i_bound  neq_n_i nth' tssb_i]
	    then
	    show ?thesis
	      using True tssb_i neq_n_i nth mth n_bound' m_bound' L_subset
	      by (auto simp add: tssb' 𝒪sb' sb Ghostsb)
	  next
	    case False
	    note neq_m_i = this
	    with m_bound mth i_bound have mth': "tssb!m = (pm, ism, θm, sbm, 𝒟m, 𝒪m,m)"
	      by (auto simp add: tssb')
	    show ?thesis
	    proof (cases "n=i")
	      case True
	      from read_only_reads_append [of "(𝒪sb  A - R)" "(takeWhile (Not  is_volatile_Writesb) sbn)"
		"(dropWhile (Not  is_volatile_Writesb) sbn)"]
	      have "read_only_reads
                (acquired True (takeWhile (Not  is_volatile_Writesb) sbn) (𝒪sb  A - R))
                (dropWhile (Not  is_volatile_Writesb) sbn)  read_only_reads (𝒪sb  A - R) sbn"
		by auto
		
	      with tssb_i nth mth neq_m_i n_bound' True
		read_only_reads_unowned [OF i_bound m_bound' False [symmetric] tssb_i mth']
	      show ?thesis
		by (auto simp add: tssb'  sb 𝒪sb' Ghostsb)
	    next
	      case False
	      with n_bound nth i_bound have nth': "tssb!n =(pn, isn, θn, sbn, 𝒟n, 𝒪n,n)"
		by (auto simp add: tssb')
	      from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m  nth' mth'] False neq_m_i
	      show ?thesis 
		by (clarsimp)
	    qed
	  qed
	qed
      next
	show "ownership_distinct tssb'"
	proof (unfold_locales)
	  fix i1 j p1 "is1" 𝒪1 1 𝒟1 xs1 sb1 pj "isj" "𝒪j" j 𝒟j xsj sbj
	  assume i1_bound: "i1 < length tssb'"
	  assume j_bound: "j < length tssb'"
	  assume i1_j: "i1  j"
	  assume ts_i1: "tssb'!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	  assume ts_j: "tssb'!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "(𝒪1  all_acquired sb1)  (𝒪j  all_acquired sbj)= {}"
	  proof (cases "i1=i")
	    case True
	    with i1_j have i_j: "ij" 
	      by simp
	    
	    from j_bound have j_bound': "j < length tssb"
	      by (simp add: tssb')
	    hence j_bound'': "j < length (map owned tssb)"
	      by simp	    
	    from ts_j i_j have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (simp add: tssb')
	    
	    from ownership_distinct [OF i_bound j_bound' i_j tssb_i ts_j']
	    show ?thesis
	      using tssb_i True ts_i1 i_bound 𝒪sb'
	      by (auto simp add: tssb' sb Ghostsb)
	  next
	    case False
	    note i1_i = this
	    from i1_bound have i1_bound': "i1 < length tssb"
	      by (simp add: tssb')
	    hence i1_bound'': "i1 < length (map owned tssb)"
	      by simp	    
	    from ts_i1 False have ts_i1': "tssb!i1 = (p1,is1,xs1,sb1,𝒟1,𝒪1,1)"
	      by (simp add: tssb')
	    show ?thesis
	    proof (cases "j=i")
	      case True
	      from ownership_distinct [OF i1_bound' i_bound  i1_i ts_i1' tssb_i]
	      show ?thesis
		using tssb_i True ts_j i_bound 𝒪sb'
		by (auto simp add: tssb' sb Ghostsb)
	    next
	      case False
	      from j_bound have j_bound': "j < length tssb"
		by (simp add: tssb')
	      from ts_j False have ts_j': "tssb!j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
		by (simp add: tssb')
	      from ownership_distinct [OF i1_bound' j_bound' i1_j ts_i1' ts_j']
	      show ?thesis .
	    qed
	  qed
	qed
      qed

      have valid_sharing': "valid_sharing (𝒮sbW RA L) tssb'"
      proof (intro_locales)
	show "outstanding_non_volatile_writes_unshared (𝒮sbW RA L) tssb'"
	proof (unfold_locales)
	  fix j pj "isj" "𝒪j" j 𝒟j acqj xsj sbj
	  assume j_bound: "j < length tssb'"
	  assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "non_volatile_writes_unshared (𝒮sbW RA L)  sbj"
	  proof (cases "i=j")
	    case True
	    with outstanding_non_volatile_writes_unshared [OF i_bound tssb_i]
	      i_bound jth tssb_i show ?thesis
	      by (clarsimp simp add: tssb' sb Ghostsb)
	  next
	    case False
	    from j_bound have j_bound': "j < length tssb"
	      by (auto simp add: tssb')
	    from jth False have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (auto simp add: tssb')
	    from j_bound jth i_bound False
	    have j: "non_volatile_writes_unshared 𝒮sb sbj"
	      apply -
	      apply (rule outstanding_non_volatile_writes_unshared)
	      apply (auto simp add: tssb')
	      done
	    from jth False have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (auto simp add: tssb')
	    from outstanding_non_volatile_writes_unshared [OF j_bound' jth']
	    have unshared: "non_volatile_writes_unshared 𝒮sb sbj".
	      
	    have "adom (𝒮sbW RA L) - dom 𝒮sb. a  outstanding_refs is_non_volatile_Writesb sbj"
	    proof -
	      {
		fix a 
		assume a_in: "a  dom (𝒮sbW RA L) - dom 𝒮sb"
		hence a_R: "a  R"
		  by clarsimp
		assume a_in_j: "a  outstanding_refs is_non_volatile_Writesb sbj"
		have False
	        proof -
		  from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF
		      outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
		      a_in_j
		  have "a  𝒪j  all_acquired sbj"
		    by auto

		  moreover
		  with ownership_distinct [OF i_bound j_bound' False tssb_i jth'] a_R R_owned
		  show False
		    by blast
		qed
	      }
	      thus ?thesis by blast
	    qed
		  
		

	    from non_volatile_writes_unshared_no_outstanding_non_volatile_Writesb 
	      [OF unshared this]
	    show ?thesis .
	  qed
	qed
      next
	show "sharing_consis (𝒮sbW RA L) tssb'"
	proof (unfold_locales)  
	  fix j pj "isj" "𝒪j" j 𝒟j acqj xsj sbj
	  assume j_bound: "j < length tssb'"
	  assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "sharing_consistent (𝒮sbW RA L) 𝒪j sbj"
	  proof (cases "i=j")
	    case True
	    with i_bound jth tssb_i sharing_consis [OF i_bound tssb_i]
	    show ?thesis
	      by (clarsimp simp add: tssb' sb Ghostsb 𝒪sb')
	  next
	    case False
	    from j_bound have j_bound': "j < length tssb"
	      by (auto simp add: tssb')
	    from jth False have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (auto simp add: tssb')
	    from sharing_consis [OF j_bound' jth']
	    have consis: "sharing_consistent 𝒮sb 𝒪j sbj".
	    
	    have acq_cond: "all_acquired sbj  dom 𝒮sb - dom (𝒮sbW RA L) = {}"
	    proof -
	      {
		fix a
		assume a_acq: "a  all_acquired sbj" 
		assume "a  dom 𝒮sb" 
		assume a_L: "a  L"
		have False
		proof -
		  from ownership_distinct [OF i_bound j_bound' False tssb_i jth']
		  have "A  all_acquired sbj = {}"
		    by (auto simp add: sb Ghostsb)
		  with a_acq a_L L_subset
		  show False
		    by blast
		qed
	      }
	      thus ?thesis
		by auto
	    qed

	    have uns_cond: "all_unshared sbj  dom (𝒮sbW RA L) - dom 𝒮sb = {}"
	    proof -
	      {
		fix a
		assume a_uns: "a  all_unshared sbj" 
		assume "a  L" 
		assume a_R:  "a  R"
		have False
	        proof -
		  from unshared_acquired_or_owned [OF consis] a_uns
		  have "a  all_acquired sbj  𝒪j" by auto
		  with ownership_distinct [OF i_bound j_bound' False tssb_i jth']  R_owned a_R
		  show False
		    by blast
		  qed
	      }
	      thus ?thesis
	        by auto
	    qed
	      
	    from sharing_consistent_preservation [OF consis acq_cond uns_cond]
	    show ?thesis
	      by (simp add: tssb')
	  qed
	qed
      next
	show "unowned_shared (𝒮sbW RA L) tssb'"
	proof (unfold_locales)
	  show "- ((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set tssb')  dom (𝒮sbW RA L)"
	  proof -
	    
	    have s: "((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set tssb') =
              ((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set tssb)  A - R"
	      
	      apply (unfold tssb' 𝒪sb') 
	      apply (rule acquire_release_ownership_nth_update [OF R_owned i_bound tssb_i])
	      apply (rule local.ownership_distinct_axioms)
	      done
	      
	    note unowned_shared L_subset A_R
	    then
	    show ?thesis
	      apply (simp only: s)
	      apply auto
	      done
	  qed
	qed
      next
	show "read_only_unowned (𝒮sbW RA L) tssb'"
	proof 
	  fix j pj "isj" "𝒪j" j 𝒟j xsj sbj
	  assume j_bound: "j < length tssb'"
	  assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "𝒪j  read_only (𝒮sbW RA L) = {}"
	  proof (cases "i=j")
	    case True
	    from read_only_unowned [OF i_bound tssb_i] 
	    have "(𝒪sb  A - R )  read_only (𝒮sbW RA L) = {}"
	      by (auto simp add: in_read_only_convs )
	    with jth tssb_i i_bound True
	    show ?thesis
	      by (auto simp add: 𝒪sb' tssb')
	  next
	    case False
	    from j_bound have j_bound': "j < length tssb"
	      by (auto simp add: tssb')
	    with False jth have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (auto simp add: tssb')
	    from read_only_unowned [OF j_bound' jth']
	    have "𝒪j  read_only 𝒮sb = {}".
	    moreover
	    from ownership_distinct [OF i_bound j_bound' False tssb_i jth'] R_owned
	    have "(𝒪sb  A)  𝒪j = {}"
	      by (auto simp add: sb Ghostsb)
	    moreover note R_owned A_R
	    ultimately show ?thesis
	      by (fastforce simp add: in_read_only_convs split: if_split_asm)
	  qed
	qed
      next
	show "no_outstanding_write_to_read_only_memory (𝒮sbW RA L) tssb'"
	proof 
	  fix j pj "isj" "𝒪j" j 𝒟j xsj sbj
	  assume j_bound: "j < length tssb'"
	  assume jth: "tssb' ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	  show "no_write_to_read_only_memory (𝒮sbW RA L) sbj"
	  proof (cases "i=j")
	    case True
	    with jth tssb_i i_bound no_outstanding_write_to_read_only_memory [OF i_bound tssb_i]
	    show ?thesis
	      by (auto simp add: sb tssb' Ghostsb)
	  next
	    case False
	    from j_bound have j_bound': "j < length tssb"
	      by (auto simp add: tssb')
	    with False jth have jth': "tssb ! j = (pj,isj,xsj,sbj,𝒟j,𝒪j,j)"
	      by (auto simp add: tssb')
	    from no_outstanding_write_to_read_only_memory [OF j_bound' jth']
	    have nw: "no_write_to_read_only_memory 𝒮sb sbj".

	    have "R  outstanding_refs is_Writesb sbj = {}"
	    proof -
	      note dist = ownership_distinct [OF i_bound j_bound' False tssb_i jth']
	      from non_volatile_owned_or_read_only_outstanding_non_volatile_writes 
	      [OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
		dist
	      have "outstanding_refs is_non_volatile_Writesb sbj  𝒪sb = {}"
	        by auto
	      moreover
	      from outstanding_volatile_writes_unowned_by_others [OF j_bound'  i_bound 
		False [symmetric] jth' tssb_i ]
	      have "outstanding_refs is_volatile_Writesb sbj  𝒪sb = {}" 
	        by auto
	      ultimately have "outstanding_refs is_Writesb sbj  𝒪sb = {}" 
	        by (auto simp add: misc_outstanding_refs_convs)
	      with R_owned
	      show ?thesis by blast
	    qed
	    then
	    have "aoutstanding_refs is_Writesb sbj.
	      a  read_only (𝒮sbW RA L)  a  read_only 𝒮sb"
	      by (auto simp add: in_read_only_convs) 
	    
	    from no_write_to_read_only_memory_read_only_reads_eq [OF nw this]
	    show ?thesis .
	  qed
	qed
      qed
      
      have valid_reads': "valid_reads msb' tssb'"
      proof -
	from valid_reads [OF i_bound tssb_i]
	have "reads_consistent False (𝒪sb  A - R) msb sb'"
	  by (simp add: sb Ghostsb)
	from valid_reads_nth_update [OF i_bound this]
	show ?thesis by (simp add: msb' tssb' 𝒪sb')
      qed
      
      have valid_program_history': "valid_program_history tssb'"
      proof -	
	from valid_program_history [OF i_bound tssb_i]
	have "causal_program_history issb sb" .
	then have causal': "causal_program_history issb sb'"
	  by (simp add: sb Ghostsb causal_program_history_def)

	from valid_last_prog [OF i_bound tssb_i]
	have "last_prog psb sb = psb".
	hence "last_prog psb sb' = psb"
	  by (simp add: sb Ghostsb)

	from valid_program_history_nth_update [OF i_bound causal' this]
	show ?thesis
	  by (simp add: tssb')
      qed

      from is_sim
      have is_sim: "instrs (dropWhile (Not  is_volatile_Writesb) sb') @ issb =
	         is @ prog_instrs (dropWhile (Not  is_volatile_Writesb) sb')"
	by (simp add: sb Ghostsb suspends)


      have "(ts,m,𝒮) d* (ts,m,𝒮)" by blast
      moreover

      note flush_commute =
	flush_all_until_volatile_write_Ghostsb_commute [OF i_bound tssb_i [simplified sb Ghostsb]]

      have dist_R_L_A: "j p is 𝒪  𝒟 θ sb.
        j < length tssb  i j
        tssb ! j = (p, is, θ, sb, 𝒟, 𝒪, ) 
        (all_shared (takeWhile (Not  is_volatile_Writesb) sb)  
         all_unshared (takeWhile (Not  is_volatile_Writesb) sb)  
         all_acquired (takeWhile (Not  is_volatile_Writesb) sb))  (R  L  A) = {}"
      proof -
        {
          fix j pj isj 𝒪j j 𝒟j θj sbj x
	  assume j_bound: "j < length tssb"
          assume neq_i_j: "i  j"
	  assume jth: "tssb!j = (pj,isj, θj,sbj,𝒟j,𝒪j,j)"
	  assume x_shared: "x  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)  
                                 all_unshared (takeWhile (Not  is_volatile_Writesb) sbj)  
                                 all_acquired  (takeWhile (Not  is_volatile_Writesb) sbj)"
          assume x_R_L_A: "x  R  L  A"
          have False
          proof -
            from x_shared all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
              unshared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
              all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" "(dropWhile (Not  is_volatile_Writesb) sbj)"]
              all_unshared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" "(dropWhile (Not  is_volatile_Writesb) sbj)"]
              all_acquired_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" "(dropWhile (Not  is_volatile_Writesb) sbj)"]
            have "x  all_acquired sbj  𝒪j "
              by auto
            moreover
            from x_R_L_A R_owned L_subset
            have "x  all_acquired sb  𝒪sb"
              by (auto simp add: sb Ghostsb)
            moreover
            note ownership_distinct [OF i_bound j_bound neq_i_j tssb_i jth]
            ultimately show False by blast
          qed
        }
        thus ?thesis by blast
      qed

      {
	fix j pj isj 𝒪j j 𝒟j θj sbj x
	assume jth: "tssb!j = (pj,isj,θj,sbj,𝒟j,𝒪j,j)"
	assume j_bound: "j < length tssb"
        assume neq: "i  j" 
        have "release (takeWhile (Not  is_volatile_Writesb) sbj)
                            (dom 𝒮sb  R - L) j
              = release (takeWhile (Not  is_volatile_Writesb) sbj)
                            (dom 𝒮sb) j"
        proof -
          {
            fix a
            assume a_in: "a  all_shared (takeWhile (Not  is_volatile_Writesb) sbj)"
            have "(a  (dom 𝒮sb  R - L)) = (a  dom 𝒮sb)"
            proof -
              from ownership_distinct [OF i_bound j_bound neq  tssb_i jth]
                
              have A_dist: "A  (𝒪j  all_acquired sbj) = {}"
                by (auto simp add: sb Ghostsb)
              
              from  all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]] a_in
                all_shared_append [of "(takeWhile (Not  is_volatile_Writesb) sbj)" 
                "(dropWhile (Not  is_volatile_Writesb) sbj)"]
              have a_in: "a  𝒪j  all_acquired sbj"
                by auto
              with ownership_distinct [OF i_bound j_bound neq  tssb_i jth]
              have "a  (𝒪sb  all_acquired sb)" by auto

              
              with A_dist R_owned A_R A_shared_owned L_subset a_in
              obtain "a  R" and "a  L"
                by fastforce
              then show ?thesis by auto
            qed
          }
          then 
          show ?thesis 
            apply -
            apply (rule release_all_shared_exchange)
            apply auto
            done
        qed
      }
      note release_commute = this
	    from ownership_distinct_axioms have "ownership_distinct tssb".
      from sharing_consis_axioms have "sharing_consis 𝒮sb tssb".
      note share_commute = share_all_until_volatile_write_Ghostsb_commute [OF ‹ownership_distinct tssb 
	‹sharing_consis 𝒮sb tssb i_bound tssb_i [simplified sb Ghostsb] dist_R_L_A]
      
      have "(tssb [i := (psb,issb, θsb, sb', 𝒟sb, 𝒪sb  A - R,augment_rels (dom 𝒮sb) R sb)],msb,𝒮sb')  (ts,m,𝒮)"
	apply (rule sim_config.intros) 
	apply    (simp add: m flush_commute)
	apply   (clarsimp simp add: 𝒮 𝒮sb' share_commute)
	using  leq
	apply  simp
	using i_bound i_bound' ts_sim ts_i is_sim 𝒟
	apply (clarsimp simp add: Let_def nth_list_update sb suspends Ghostsbsb' 𝒮sb'
	   split: if_split_asm)
        apply (rule conjI)
        apply  fastforce
        apply clarsimp
        apply (frule (2) release_commute)
        apply clarsimp
        apply auto
	done	
      ultimately
      show ?thesis
	using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' 
	  valid_dd' valid_sops' load_tmps_fresh' enough_flushs' 
	  valid_program_history' valid'
	  msb' 𝒮sb' tssb' 
	by (auto simp del: fun_upd_apply simp add: 𝒪sb' ℛsb')
    qed
 next
    case (Program i psb "issb" θsb sb 𝒟sb 𝒪sb sb psb' mis)
    then obtain
      tssb': "tssb' = tssb[i := (psb', issb@mis, θsb, sb@[Progsb psb psb' mis], 𝒟sb, 𝒪sb,sb)]" and
      i_bound: "i < length tssb" and
      tssb_i: "tssb ! i = (psb, issb,θsb,sb, 𝒟sb, 𝒪sb,sb)" and
      prog: "θsb psb p (psb',mis)" and
      𝒮sb': "𝒮sb'=𝒮sb" and
      msb': "msb'=msb"
      by auto

    from sim obtain 
      m: "m = flush_all_until_volatile_write tssb msb" and
      𝒮: "𝒮 = share_all_until_volatile_write tssb 𝒮sb" and
      leq: "length tssb = length ts" and
      ts_sim: "i<length tssb.
           let (p, issb, θ, sb, 𝒟sb, 𝒪sb,) = tssb ! i;
               suspends = dropWhile (Not  is_volatile_Writesb) sb
           in  is 𝒟. instrs suspends @ issb = is @ prog_instrs suspends  
                          𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb sb  {}) 
               ts ! i =
                   (hd_prog p suspends, 
                    is,
                    θ |` (dom θ - read_tmps suspends), (),
                    𝒟, 
                    acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪sb,
                    release (takeWhile (Not  is_volatile_Writesb) sb) (dom 𝒮sb) )"
      by cases blast

    from i_bound leq have i_bound': "i < length ts"
      by auto

    have split_sb: "sb = takeWhile (Not  is_volatile_Writesb) sb @ dropWhile (Not  is_volatile_Writesb) sb"
      (is "sb = ?take_sb@?drop_sb")
      by simp

    from ts_sim [rule_format, OF i_bound] tssb_i obtain suspends "is" 𝒟 where
      suspends: "suspends = dropWhile (Not  is_volatile_Writesb) sb" and
      is_sim: "instrs suspends @ issb = is @ prog_instrs suspends" and
      𝒟: "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb sb  {})" and
      ts_i: "ts ! i =
          (hd_prog psb suspends, is,
           θsb |` (dom θsb - read_tmps suspends), (), 𝒟, acquired True ?take_sb 𝒪sb,
           release ?take_sb (dom 𝒮sb) sb)"
      by (auto simp add: Let_def)

    from prog_step_preserves_valid [OF i_bound tssb_i prog valid]
    have valid': "valid tssb'"
      by (simp add: tssb')

    have valid_own': "valid_ownership 𝒮sb' tssb'"
    proof (intro_locales)
      show "outstanding_non_volatile_refs_owned_or_read_only 𝒮sb' tssb'"
      proof -
	from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound tssb_i] 
	have "non_volatile_owned_or_read_only False 𝒮sb 𝒪sb (sb@[Progsb psb psb' mis])"
	  by (auto simp add: non_volatile_owned_or_read_only_append)
	from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
	show ?thesis by (simp add: tssb' 𝒮sb')
      qed
    next
      show "outstanding_volatile_writes_unowned_by_others tssb'"
      proof -
	have out: "outstanding_refs is_volatile_Writesb (sb@[Progsb psb psb' mis])  
	      outstanding_refs is_volatile_Writesb sb"
	  by (auto simp add: outstanding_refs_conv )
	from outstanding_volatile_writes_unowned_by_others_store_buffer 
	[OF i_bound tssb_i this]
	show ?thesis by (simp add: tssb' all_acquired_append)
      qed
    next
      show "read_only_reads_unowned tssb'"
      proof -
	have ro: "read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) (sb@[Progsb psb psb' mis])) 𝒪sb)
	  (dropWhile (Not  is_volatile_Writesb) (sb@[Progsb psb psb' mis]))
	   read_only_reads (acquired True (takeWhile (Not  is_volatile_Writesb) sb) 𝒪sb)
	  (dropWhile (Not  is_volatile_Writesb) sb)"
	  apply (case_tac "outstanding_refs (is_volatile_Writesb) sb = {}")
	  apply (simp_all add: outstanding_vol_write_take_drop_appends
	    acquired_append read_only_reads_append )
	  done
	have "𝒪sb  all_acquired (sb@[Progsb psb psb' mis])  𝒪sb  all_acquired sb"
	  by (auto simp add: all_acquired_append)
	from read_only_reads_unowned_nth_update [OF i_bound tssb_i ro this] 
	show ?thesis
	  by (simp add: tssb' )
      qed
    next
      show "ownership_distinct tssb'"
      proof -
	from ownership_distinct_instructions_read_value_store_buffer_independent 
	[OF i_bound tssb_i, where sb'="(sb@[Progsb psb psb' mis])"]
	show ?thesis by (simp add: tssb' all_acquired_append)
      qed
    qed

    from valid_last_prog [OF i_bound tssb_i]
    have last_prog: "last_prog psb sb = psb".
    
    have valid_hist': "valid_history program_step tssb'"
    proof -
      from valid_history [OF i_bound tssb_i]
      have "history_consistent θsb (hd_prog psb sb) sb".
      from history_consistent_append_Progsb [OF prog this last_prog]
      have hist_consis': "history_consistent θsb (hd_prog psb' (sb@[Progsb psb psb' mis])) 
        (sb@[Progsb psb psb' mis])".
      from valid_history_nth_update [OF i_bound this]
      show ?thesis by (simp add: tssb')
    qed


    have valid_reads': "valid_reads msb tssb'"
    proof -
      from valid_reads [OF i_bound tssb_i]
      have "reads_consistent False 𝒪sb msb sb" .
      from reads_consistent_snoc_Progsb [OF this] 
      have "reads_consistent False 𝒪sb msb  (sb@[Progsb psb psb' mis])".
      from valid_reads_nth_update [OF i_bound this]
      show ?thesis by (simp add: tssb')
    qed

    have valid_sharing': "valid_sharing 𝒮sb' tssb'"
    proof (intro_locales)	
      from outstanding_non_volatile_writes_unshared [OF i_bound tssb_i] 
      have "non_volatile_writes_unshared 𝒮sb (sb@[Progsb psb psb' mis])"
	by (auto simp add: non_volatile_writes_unshared_append)
      from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
      show "outstanding_non_volatile_writes_unshared 𝒮sb' tssb'"
	by (simp add: tssb' 𝒮sb')
    next
      from sharing_consis [OF i_bound tssb_i]
      have "sharing_consistent 𝒮sb 𝒪sb (sb@[Progsb psb psb' mis])"
	by (auto simp add: sharing_consistent_append)
      from sharing_consis_nth_update [OF i_bound this]
      show "sharing_consis 𝒮sb' tssb'"
	by (simp add: tssb' 𝒮sb')
    next
      from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound tssb_i] ]
      show "read_only_unowned 𝒮sb' tssb'"
	by (simp add: 𝒮sb' tssb')
    next
      from unowned_shared_nth_update [OF i_bound tssb_i subset_refl]
      show "unowned_shared 𝒮sb' tssb'"
	by (simp add: tssb' 𝒮sb')
    next
      from no_outstanding_write_to_read_only_memory [OF i_bound tssb_i] 

      have "no_write_to_read_only_memory 𝒮sb (sb @ [Progsb psb psb' mis])"
	by (simp add: no_write_to_read_only_memory_append)
	
      from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
      show "no_outstanding_write_to_read_only_memory 𝒮sb' tssb'"
	by (simp add: 𝒮sb' tssb')
    qed

    have tmps_distinct': "tmps_distinct tssb'"
    proof (intro_locales)
      from load_tmps_distinct [OF i_bound tssb_i]
      have "distinct_load_tmps issb".
      with distinct_load_tmps_prog_step [OF i_bound tssb_i prog valid] 
      have "distinct_load_tmps (issb@mis)" 
	by (auto simp add: distinct_load_tmps_append)
	
      from load_tmps_distinct_nth_update [OF i_bound this]
      show "load_tmps_distinct tssb'"
	by (simp add: tssb')
    next
      from read_tmps_distinct [OF i_bound tssb_i]
      have "distinct_read_tmps (sb@[Progsb psb psb' mis])"
	by (simp add: distinct_read_tmps_append)
      from read_tmps_distinct_nth_update [OF i_bound this]
      show "read_tmps_distinct tssb'"
	by (simp add: tssb')
    next
      from load_tmps_read_tmps_distinct [OF i_bound tssb_i]
	distinct_load_tmps_prog_step [OF i_bound tssb_i prog valid] 
      have "load_tmps (issb@mis)  read_tmps (sb@[Progsb psb psb' mis]) = {}"
	by (auto simp add: read_tmps_append load_tmps_append)
      from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
      show "load_tmps_read_tmps_distinct tssb'" by (simp add: tssb')
    qed

    have valid_dd': "valid_data_dependency tssb'"
    proof -
      from data_dependency_consistent_instrs [OF i_bound tssb_i]
      have "data_dependency_consistent_instrs (dom θsb) issb".
      with valid_data_dependency_prog_step [OF i_bound tssb_i prog valid]  
	   load_tmps_write_tmps_distinct [OF i_bound tssb_i]
      obtain
	"data_dependency_consistent_instrs (dom θsb) (issb@mis)"
	"load_tmps (issb@mis)  (fst ` write_sops (sb@[Progsb psb psb' mis]))  = {}"
	by (force simp add: load_tmps_append data_dependency_consistent_instrs_append
	 write_sops_append)
      from valid_data_dependency_nth_update [OF i_bound this]
      show ?thesis
	by (simp add: tssb')
    qed

    have load_tmps_fresh': "load_tmps_fresh tssb'"
    proof -
      
      from load_tmps_fresh [OF i_bound tssb_i] 
      load_tmps_fresh_prog_step [OF i_bound tssb_i prog valid]
      have "load_tmps (issb@mis)  dom θsb = {}"
	by (auto simp add: load_tmps_append)
      from load_tmps_fresh_nth_update [OF i_bound this]
      show ?thesis
	by (simp add:  tssb')
    qed

    have enough_flushs': "enough_flushs tssb'"
    proof -
      from clean_no_outstanding_volatile_Writesb [OF i_bound tssb_i]
      have "¬ 𝒟sb  outstanding_refs is_volatile_Writesb (sb@[Progsb psb psb' mis]) = {}"
	by (auto simp add: outstanding_refs_append)

      from enough_flushs_nth_update [OF i_bound this]
      show ?thesis
	by (simp add: tssb')
    qed

    have valid_sops': "valid_sops tssb'"
    proof -
      from valid_store_sops [OF i_bound tssb_i] valid_sops_prog_step [OF prog] 
	valid_implies_valid_prog[OF i_bound tssb_i valid]
      have valid_store: "sopstore_sops (issb@mis). valid_sop sop"
	by (auto simp add: store_sops_append)

      from valid_write_sops [OF i_bound tssb_i]
      have "sopwrite_sops (sb@[Progsb psb psb' mis]). valid_sop sop"
	by (auto simp add: write_sops_append)
      from     valid_sops_nth_update [OF i_bound this valid_store]
      show ?thesis
	by (simp add: tssb')
    qed

    have valid_program_history':"valid_program_history tssb'"
    proof -	
      from valid_program_history [OF i_bound tssb_i]
      have "causal_program_history issb sb" .
      from causal_program_history_Progsb [OF this]
      have causal': "causal_program_history (issb@mis) (sb@[Progsb psb psb' mis])".
      from last_prog_append_Progsb
      have "last_prog psb' (sb@[Progsb psb psb' mis]) = psb'".
      from valid_program_history_nth_update [OF i_bound causal' this]
      show ?thesis
	by (simp add: tssb')
    qed

    show ?thesis
    proof (cases "outstanding_refs is_volatile_Writesb sb = {}")
      case True
      from True have flush_all: "takeWhile (Not  is_volatile_Writesb) sb = sb"
	by (auto simp add: outstanding_refs_conv)
      
      from True have suspend_nothing: "dropWhile (Not  is_volatile_Writesb) sb = []"
	by (auto simp add: outstanding_refs_conv)

      hence suspends_empty: "suspends = []"
	by (simp add: suspends)

      from suspends_empty is_sim have "is": "is = issb"
	by (simp)

      from ts_i have ts_i: "ts ! i = (psb, issb, θsb, (), 
	𝒟, acquired True ?take_sb 𝒪sb,release ?take_sb (dom 𝒮sb) sb)"
	by (simp add: suspends_empty "is")

      from direct_computation.Program [OF i_bound' ts_i prog]
      have "(ts,m,𝒮) d (ts[i := (psb', issb @ mis, θsb, (),
	𝒟, acquired True ?take_sb 𝒪sb,release ?take_sb (dom 𝒮sb) sb)], m, 𝒮)".
    
      moreover

      note flush_commute = flush_all_until_volatile_write_append_Progsb_commute [OF i_bound tssb_i]

      from True
      have suspend_nothing':
	"(dropWhile (Not  is_volatile_Writesb) (sb @ [Progsb psb psb' mis])) = []"
	by (auto simp add: outstanding_refs_conv)

      note share_commute =
	share_all_until_volatile_write_update_sb [OF share_append_Progsb i_bound tssb_i]

      from 𝒟
      have 𝒟': "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb (sb@[Progsb psb psb' mis])   {})"
	by (auto simp: outstanding_refs_append)

      have "(tssb [i := (psb',issb@mis, θsb, sb@[Progsb psb psb' mis], 𝒟sb, 𝒪sb,sb)],
              msb,𝒮sb')  
              (ts[i:=(psb', issb @ mis, θsb, (), 𝒟, 
                  acquired True (takeWhile (Not  is_volatile_Writesb) 
                    (sb@[Progsb psb psb' mis])) 𝒪sb,
                   release (sb@[Progsb psb psb' mis])  (dom 𝒮sb) sb )],m,𝒮)"
	apply (rule sim_config.intros) 
	apply    (simp add: m flush_commute)
	apply   (clarsimp simp add: 𝒮 𝒮sb' share_commute)
	using  leq
	apply  simp
	
	using i_bound i_bound' ts_sim ts_i 𝒟'
	apply (clarsimp simp add: Let_def nth_list_update  flush_all suspend_nothing' Progsb 𝒮sb' 
          release_append_Progsb release_append
	   split: if_split_asm)
	done	
      ultimately show ?thesis
	using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' msb'
	  valid_dd' valid_sops' load_tmps_fresh' enough_flushs' valid_sharing' 
	  valid_program_history' valid'  
	  𝒮sb' tssb'  
	by (auto simp del: fun_upd_apply simp add: acquired_append_Progsb release_append_Progsb release_append flush_all) 
    next
      case False

      then obtain r where r_in: "r  set sb" and volatile_r: "is_volatile_Writesb r"
	by (auto simp add: outstanding_refs_conv)
      from takeWhile_dropWhile_real_prefix 
      [OF r_in, of  "(Not  is_volatile_Writesb)", simplified, OF volatile_r] 
      obtain a' v' sb'' sop' A' L' R' W' where
	sb_split: "sb = takeWhile (Not  is_volatile_Writesb) sb @ Writesb True a' sop' v' A' L' R' W'# sb''" 
	and
	drop: "dropWhile (Not  is_volatile_Writesb) sb = Writesb True a' sop' v' A' L' R' W'# sb''"
	apply (auto)
	subgoal for y
	apply (case_tac y)
	apply auto
	done
  done
      from drop suspends have suspends': "suspends = Writesb True a' sop' v' A' L' R' W'# sb''"
	by simp

      have "(ts, m, 𝒮) d* (ts, m, 𝒮)" by auto
      
      moreover

      note flush_commute= flush_all_until_volatile_write_append_Progsb_commute [OF i_bound tssb_i]

      have "Writesb True a' sop' v' A' L' R' W'  set sb"
	by (subst sb_split) auto

      from dropWhile_append1 [OF this, of "(Not  is_volatile_Writesb)"]
      have drop_app_comm:
	  "(dropWhile (Not  is_volatile_Writesb) (sb @ [Progsb psb psb' mis])) =
                dropWhile (Not  is_volatile_Writesb) sb @ [Progsb psb psb' mis]"
	by simp

      note share_commute =
	share_all_until_volatile_write_update_sb [OF share_append_Progsb i_bound tssb_i]

      from 𝒟
      have 𝒟': "𝒟sb = (𝒟  outstanding_refs is_volatile_Writesb (sb@[Progsb psb psb' mis])   {})"
	by (auto simp: outstanding_refs_append)
      have "(tssb [i := (psb',issb@mis,θsb, sb@[Progsb psb psb' mis], 𝒟sb, 𝒪sb,sb)],
              msb,𝒮sb')  
              (ts,m,𝒮)"
	apply (rule sim_config.intros) 
	apply    (simp add: m flush_commute)
	apply   (clarsimp  simp add: 𝒮 𝒮sb' share_commute)
	using  leq
	apply  simp
	
	using i_bound i_bound' ts_sim ts_i is_sim suspends  suspends' [simplified suspends] 𝒟'
	apply (clarsimp simp add: Let_def nth_list_update Progsb
	  drop_app_comm instrs_append prog_instrs_append  
	  read_tmps_append hd_prog_append_Progsb acquired_append_Progsb release_append_Progsb release_append 𝒮sb'
	   split: if_split_asm)
	done	

      ultimately show ?thesis
	using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' msb'
	  valid_dd' valid_sops' load_tmps_fresh' enough_flushs' valid_sharing' 
	  valid_program_history' valid'
	  𝒮sb' tssb' 
	by (auto simp del: fun_upd_apply)
    qed
  qed
qed


theorem (in xvalid_program) concurrent_direct_steps_simulates_store_buffer_history_steps:
  assumes step_sb: "(tssb,msb,𝒮sb) sbh* (tssb',msb',𝒮sb')"
  assumes valid_own: "valid_ownership 𝒮sb tssb"
  assumes valid_sb_reads: "valid_reads msb tssb"
  assumes valid_hist: "valid_history program_step tssb"
  assumes valid_sharing: "valid_sharing 𝒮sb tssb"
  assumes tmps_distinct: "tmps_distinct tssb"
  assumes valid_sops: "valid_sops tssb"
  assumes valid_dd: "valid_data_dependency tssb"
  assumes load_tmps_fresh: "load_tmps_fresh tssb"
  assumes enough_flushs: "enough_flushs tssb"
  assumes valid_program_history: "valid_program_history tssb"
  assumes valid: "valid tssb"
  shows "ts 𝒮 m. (tssb,msb,𝒮sb)  (ts,m,𝒮)  safe_reach_direct safe_delayed (ts,m,𝒮) 
         valid_ownership 𝒮sb' tssb'  valid_reads msb' tssb'  valid_history program_step tssb' 
         valid_sharing 𝒮sb' tssb'  tmps_distinct tssb'  valid_data_dependency tssb' 
         valid_sops tssb'  load_tmps_fresh tssb'  enough_flushs tssb' 
         valid_program_history tssb'  valid tssb' 
           (ts' m' 𝒮'. (ts,m,𝒮) d* (ts',m',𝒮')  (tssb',msb',𝒮sb')  (ts',m',𝒮'))"
using step_sb valid_own valid_sb_reads valid_hist valid_sharing tmps_distinct valid_sops 
  valid_dd load_tmps_fresh enough_flushs valid_program_history valid
proof (induct rule: converse_rtranclp_induct_sbh_steps)
  case refl thus ?case
    by auto
next
  case (step tssb  msb 𝒮sb tssb''  msb'' 𝒮sb'')
  note first = (tssb, msb, 𝒮sb) sbh (tssb'', msb'', 𝒮sb'')
  note sim = (tssb, msb, 𝒮sb)  (ts, m, 𝒮)
  note safe_reach = ‹safe_reach_direct safe_delayed (ts, m, 𝒮)
  note valid_own = ‹valid_ownership 𝒮sb tssb
  note valid_reads = ‹valid_reads msb tssb
  note valid_hist = ‹valid_history program_step tssb
  note valid_sharing = ‹valid_sharing 𝒮sb tssb
  note tmps_distinct = ‹tmps_distinct tssb
  note valid_sops = ‹valid_sops tssb
  note valid_dd = ‹valid_data_dependency tssb
  note load_tmps_fresh = ‹load_tmps_fresh tssb
  note enough_flushs = ‹enough_flushs tssb
  note valid_prog_hist = ‹valid_program_history tssb
  note valid = valid tssb
  from concurrent_direct_steps_simulates_store_buffer_history_step [OF first
  valid_own valid_reads valid_hist valid_sharing tmps_distinct valid_sops valid_dd
  load_tmps_fresh enough_flushs valid_prog_hist valid sim safe_reach]
  obtain ts'' m'' 𝒮'' where
    valid_own'': "valid_ownership 𝒮sb'' tssb''" and
    valid_reads'': "valid_reads msb'' tssb''" and
    valid_hist'': "valid_history program_step tssb''" and
    valid_sharing'': "valid_sharing 𝒮sb'' tssb''" and
    tmps_dist'': "tmps_distinct tssb''" and
    valid_dd'': "valid_data_dependency tssb''" and
    valid_sops'': "valid_sops tssb''" and
    load_tmps_fresh'': "load_tmps_fresh tssb''" and
    enough_flushs'': "enough_flushs tssb''" and
    valid_prog_hist'': "valid_program_history tssb''"and
    valid'': "valid tssb''" and
    steps: "(ts, m, 𝒮) d* (ts'', m'', 𝒮'')" and
    sim: "(tssb'', msb'',𝒮sb'')  (ts'', m'',𝒮'')"
    by blast
 

  from step.hyps (3) [OF sim safe_reach_steps [OF safe_reach steps] valid_own'' valid_reads'' valid_hist'' valid_sharing''
  tmps_dist'' valid_sops'' valid_dd'' load_tmps_fresh'' enough_flushs'' valid_prog_hist'' valid'' ]

  obtain ts' m' 𝒮' where
    valid: "valid_ownership 𝒮sb' tssb'" "valid_reads msb' tssb'" "valid_history program_step tssb'"
    "valid_sharing 𝒮sb' tssb'" "tmps_distinct tssb'" "valid_data_dependency tssb'"
    "valid_sops tssb'" "load_tmps_fresh tssb'" "enough_flushs tssb'"
    "valid_program_history tssb'" "valid tssb'" and
    last: "(ts'', m'', 𝒮'') d* (ts', m', 𝒮')" and
    sim': "(tssb', msb',𝒮sb')  (ts', m',𝒮')"
    by blast

  note steps also note last
  finally show ?case
    using valid sim'
    by blast
qed

(* FIXME: move up *)
sublocale initialsb  tmps_distinct ..
locale xvalid_program_progress = program_progress + xvalid_program

theorem (in xvalid_program_progress) concurrent_direct_execution_simulates_store_buffer_history_execution:
assumes exec_sb: "(tssb,msb,𝒮sb) sbh* (tssb',msb',𝒮sb')"
assumes init: "initialsb tssb 𝒮sb"
assumes valid: "valid tssb" (* FIXME: move into initial ?*)
assumes sim: "(tssb,msb,𝒮sb)  (ts,m,𝒮)"
assumes safe: "safe_reach_direct safe_free_flowing (ts,m,𝒮)"
shows "ts' m' 𝒮'. (ts,m,𝒮) d* (ts',m',𝒮')  
                (tssb',msb',𝒮sb')  (ts',m',𝒮')"
proof -
  from init interpret ini: initialsb tssb 𝒮sb .
  from safe_free_flowing_implies_safe_delayed' [OF init sim safe]
  have safe_delayed: "safe_reach_direct safe_delayed (ts, m, 𝒮)".
  from local.ini.valid_ownership_axioms have "valid_ownership 𝒮sb tssb" .
  from local.ini.valid_reads_axioms have "valid_reads msb tssb".
  from local.ini.valid_history_axioms have "valid_history program_step tssb".
  from local.ini.valid_sharing_axioms have "valid_sharing 𝒮sb tssb".
  from local.ini.tmps_distinct_axioms have "tmps_distinct tssb".
  from local.ini.valid_sops_axioms have "valid_sops tssb".
  from local.ini.valid_data_dependency_axioms have "valid_data_dependency tssb".  
  from local.ini.load_tmps_fresh_axioms have "load_tmps_fresh tssb".
  from local.ini.enough_flushs_axioms have "enough_flushs tssb".
  from local.ini.valid_program_history_axioms have "valid_program_history tssb".
  from concurrent_direct_steps_simulates_store_buffer_history_steps [OF exec_sb 
    ‹valid_ownership 𝒮sb tssb
    ‹valid_reads msb tssb ‹valid_history program_step tssb
    ‹valid_sharing 𝒮sb tssb ‹tmps_distinct tssb ‹valid_sops tssb
    ‹valid_data_dependency tssb ‹load_tmps_fresh tssb ‹enough_flushs tssb
   ‹valid_program_history tssb valid sim safe_delayed]
  show ?thesis by auto
qed





lemma filter_is_Writesb_Cons_Writesb: "filter is_Writesb xs = Writesb volatile a sop v A L R W#ys
       rs rws. (r  set rs. is_Readsb r  is_Progsb r  is_Ghostsb r)  
              xs=rs@Writesb volatile a sop v A L R W#rws  ys=filter is_Writesb rws"
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x xs)
  note feq = ‹filter is_Writesb (x#xs) = Writesb volatile a sop v A L R W# ys
  show ?case
  proof (cases x)
    case (Writesb volatile' a' sop' v' A' L' R' W')
    with feq obtain "volatile'=volatile" "a'=a" "v'=v" "sop'=sop" "A'=A" "L'=L" "R'=R" "W'=W"
      "ys = filter is_Writesb xs"
      by auto
    thus ?thesis
      apply -
      apply (rule_tac x="[]" in exI)
      apply (rule_tac x="xs" in exI)
      apply (simp add: Writesb)
      done
  next
    case (Readsb volatile' a' t' v')
    from feq have "filter is_Writesb xs = Writesb volatile a sop v A L R W#ys"
      by (simp add: Readsb)
    from Cons.hyps [OF this] obtain rs rws where
      "r  set rs. is_Readsb r  is_Progsb r  is_Ghostsb r" and
      "xs=rs @ Writesb volatile a sop v A L R W# rws" and
      "ys=filter is_Writesb rws"
      by clarsimp
    then show ?thesis
      apply -
      apply (rule_tac x="Readsb volatile' a' t' v'#rs" in exI)
      apply (rule_tac x="rws" in exI)
      apply (simp add: Readsb)
      done
  next
    case (Progsb p1 p2 mis)
    from feq have "filter is_Writesb xs = Writesb volatile a sop v A L R W#ys"
      by (simp add: Progsb)
    from Cons.hyps [OF this] obtain rs rws where
      "r  set rs. is_Readsb r  is_Progsb r  is_Ghostsb r" and
      "xs=rs @ Writesb volatile a sop v A L R W# rws" and
      "ys=filter is_Writesb rws"
      by clarsimp
    then show ?thesis
      apply -
      apply (rule_tac x="Progsb p1 p2 mis#rs" in exI)
      apply (rule_tac x="rws" in exI)
      apply (simp add: Progsb)
      done
    next
    case (Ghostsb A' L' R' W')
    from feq have "filter is_Writesb xs = Writesb volatile a sop v A L R W # ys"
      by (simp add: Ghostsb)
    from Cons.hyps [OF this] obtain rs rws where
      "r  set rs. is_Readsb r  is_Progsb r  is_Ghostsb r" and
      "xs=rs @ Writesb volatile a sop v A L R W# rws" and
      "ys=filter is_Writesb rws"
      by clarsimp
    then show ?thesis
      apply -
      apply (rule_tac x="Ghostsb A' L' R' W'#rs" in exI)
      apply (rule_tac x="rws" in exI)
      apply (simp add: Ghostsb)
      done
  qed
qed

lemma filter_is_Writesb_empty: "filter is_Writesb xs = []
       (r  set xs. is_Readsb r  is_Progsb r  is_Ghostsb r)"
proof (induct xs)
  case Nil thus ?case by simp
next
  case (Cons x xs)
  note feq = ‹filter is_Writesb (x#xs) = []
  show ?case
  proof (cases x)
    case (Writesb volatile' a' v')
    with feq have False
      by simp
    thus ?thesis ..
  next
    case (Readsb a' v')
    from feq have "filter is_Writesb xs = []"
      by (simp add: Readsb)
    from Cons.hyps [OF this] obtain 
      "r  set xs. is_Readsb r  is_Progsb r  is_Ghostsb r" 
      by clarsimp
    then show ?thesis
      by (simp add: Readsb)
  next
    case (Progsb p2 p2 mis)
    from feq have "filter is_Writesb xs = []"
      by (simp add: Progsb)
    from Cons.hyps [OF this] obtain 
      "r  set xs. is_Readsb r  is_Progsb r  is_Ghostsb r" 
      by clarsimp
    then show ?thesis
      by (simp add: Progsb)
  next
    case (Ghostsb A' L' R' W')
    from feq have "filter is_Writesb xs = []"
      by (simp add: Ghostsb)
    from Cons.hyps [OF this] obtain 
      "r  set xs. is_Readsb r  is_Progsb r  is_Ghostsb r" 
      by clarsimp
    then show ?thesis
      by (simp add: Ghostsb)
  qed
qed

lemma flush_reads_program: "𝒪 𝒮  .
  r  set sb. is_Readsb r  is_Progsb r  is_Ghostsb r  
𝒪' ℛ' 𝒮'. (m,sb,𝒪,,𝒮) f* (m,[],𝒪',ℛ',𝒮')"      
proof (induct sb)
  case Nil thus ?case by auto
next
  case (Cons x sb)
  note rset (x # sb). is_Readsb r  is_Progsb r  is_Ghostsb r
  then obtain  x: "is_Readsb x  is_Progsb x  is_Ghostsb x" and sb: "rset sb. is_Readsb r  is_Progsb r  is_Ghostsb r"
    by (cases x) auto

  
  {
    assume "is_Readsb x"
    then obtain volatile a t v where x: "x=Readsb volatile a t v"
      by (cases x) auto
    
    have "(m,Readsb volatile a t v#sb,𝒪,,𝒮) f (m,sb,𝒪,,𝒮)"
      by (rule Readsb)
    also
    from Cons.hyps [OF sb] obtain 𝒪' 𝒮' acq' ℛ'
      where "(m, sb,𝒪,,𝒮) f* (m, [],𝒪',ℛ',𝒮')" by blast
    finally
    have ?case
      by (auto simp add: x)
  }
  moreover
  {
    assume "is_Progsb x"
    then obtain p1 p2 mis  where x: "x=Progsb p1 p2 mis"
      by (cases x) auto
    
    have "(m,Progsb p1 p2 mis#sb,𝒪,,𝒮) f (m,sb,𝒪,,𝒮)"
      by (rule Progsb)
    also
    from Cons.hyps [OF sb] obtain 𝒪' ℛ' 𝒮' acq' 
    where "(m, sb,𝒪,,𝒮) f* (m, [],𝒪',ℛ',𝒮')" by blast
    finally
    have ?case
      by (auto simp add: x)
  }
  moreover
  {
    assume "is_Ghostsb x"
    then obtain A L R W where x: "x=Ghostsb A L R W"
      by (cases x) auto
    
    have "(m,Ghostsb A L R W#sb,𝒪,,𝒮) f (m,sb,𝒪  A - R,augment_rels (dom 𝒮) R ,𝒮W RA L)"
      by (rule Ghost)
    also
    from Cons.hyps [OF sb] obtain 𝒪' 𝒮' ℛ' acq'
    where "(m, sb,𝒪  A - R ,augment_rels (dom 𝒮) R ,𝒮W RA L) f* (m, [],𝒪',ℛ',𝒮')" by blast
    finally
    have ?case
      by (auto simp add: x)
  }
  ultimately show ?case
    using x by blast
qed


lemma flush_progress: "m' 𝒪' 𝒮' ℛ'. (m,r#sb,𝒪,,𝒮) f (m',sb,𝒪',ℛ',𝒮')"
proof (cases r)
  case (Writesb volatile a sop v A L R W)
  from flush_step.Writesb  [OF refl refl refl, of m volatile a sop v A L R W sb 𝒪  𝒮]
  show ?thesis
    by (auto simp add: Writesb)
next
  case (Readsb volatile a t v)
  from flush_step.Readsb [of m volatile a t v sb 𝒪  𝒮]
  show ?thesis
    by (auto simp add: Readsb)
next
  case (Progsb p1 p2 mis)
  from flush_step.Progsb [of m p1 p2 mis sb 𝒪  𝒮]  
  show ?thesis
    by (auto simp add: Progsb)
next
  case (Ghostsb A L R W)
  from flush_step.Ghost [of m A L R W sb 𝒪  𝒮]
  show ?thesis
    by (auto simp add: Ghostsb)
qed

lemma flush_empty: 
  assumes steps: "(m, sb,𝒪,, 𝒮) f* (m', sb',𝒪',ℛ',𝒮')"
  shows "sb=[]  m'=m  sb'=[]  𝒪'=𝒪  ℛ'=  𝒮'=𝒮 "
using steps
apply (induct rule:  converse_rtranclp_induct5)
apply (auto elim: flush_step.cases)
done

lemma flush_append: 
  assumes steps: "(m, sb,𝒪,,𝒮) f* (m', sb',𝒪',ℛ',𝒮')" 
  shows "xs. (m, sb@xs,𝒪,,𝒮) f* (m', sb'@xs,𝒪',ℛ',𝒮')"
using steps
proof (induct rule: converse_rtranclp_induct5)
  case refl thus ?case by auto
next
  case (step m sb 𝒪  𝒮 m'' sb'' 𝒪'' ℛ'' 𝒮'')
  note first=  (m,sb,𝒪,,𝒮) f (m'',sb'',𝒪'',ℛ'',𝒮'')
  note rest = (m'', sb'',𝒪'',ℛ'',𝒮'') f* (m', sb',𝒪',ℛ',𝒮')
  from step.hyps (3)  have append_rest: "(m'', sb''@xs,𝒪'',ℛ'',𝒮'') f* (m', sb'@xs,𝒪',ℛ',𝒮')".
  from first show ?case
  proof (cases)
    case (Writesb volatile A R W L a sop v)
    then obtain sb: "sb=Writesb volatile a sop v A L R W#sb''" and m'': "m''=m(a:=v)" and 
      𝒪'': "𝒪''=(if volatile then 𝒪  A - R else 𝒪)" and
      ℛ'': "ℛ''=(if volatile then Map.empty else )" and
      𝒮'': "𝒮''=(if volatile then 𝒮W RA L else 𝒮)"
      by auto
    have "(m,Writesb volatile a sop v A L R W#sb''@xs,𝒪,,𝒮) f 
      (m(a:=v),sb''@xs,if volatile then 𝒪  A - R else 𝒪,if volatile then Map.empty else ,
      if volatile then 𝒮W RA L else 𝒮)"
      apply (rule flush_step.Writesb)
      apply auto
      done
    hence "(m,sb@xs,𝒪,,𝒮) f (m'',sb''@xs,𝒪'',ℛ'',𝒮'')"
      by (simp add: sb m'' 𝒪'' ℛ'' 𝒮'')
    also note append_rest
    finally show ?thesis .
  next
    case (Readsb volatile a t v)
    then obtain sb: "sb=Readsb volatile a t v #sb''" and m'': "m''=m" 
      and 𝒪'': "𝒪''=𝒪" and 𝒮'': "𝒮''=𝒮" and ℛ'': "ℛ''=" 
      by auto
    have "(m,Readsb volatile a t v#sb''@xs,𝒪,,𝒮) f (m,sb''@xs,𝒪,,𝒮)"
      by (rule flush_step.Readsb)
    hence "(m,sb@xs,𝒪,,𝒮) f (m'',sb''@xs,𝒪'',ℛ'',𝒮'')"
      by (simp add: sb m'' 𝒪'' ℛ'' 𝒮'' )
    also note append_rest
    finally show ?thesis .
  next
    case (Progsb p1 p2 mis)
    then obtain sb: "sb=Progsb p1 p2 mis#sb''" and m'': "m''=m"
      and 𝒪'': "𝒪''=𝒪" and 𝒮'': "𝒮''=𝒮" and ℛ'': "ℛ''=" 
      by auto
    have "(m,Progsb p1 p2 mis#sb''@xs,𝒪,,𝒮) f (m,sb''@xs,𝒪,,𝒮)"
      by (rule flush_step.Progsb)
    hence "(m,sb@xs,𝒪,,𝒮) f (m'',sb''@xs,𝒪'',ℛ'',𝒮'')"
      by (simp add: sb m'' 𝒪'' ℛ'' 𝒮'' ) 
    also note append_rest
    finally show ?thesis .
  next
    case (Ghost A L R W)
    then obtain sb: "sb=Ghostsb A L R W#sb''" and m'': "m''=m"
      and 𝒪'': "𝒪''=𝒪  A - R" and 𝒮'': "𝒮''=𝒮W RA  L" and 
      ℛ'': "ℛ''=augment_rels (dom 𝒮) R "
      by auto
    have "(m,Ghostsb A L R W#sb''@xs,𝒪,,𝒮) f (m,sb''@xs,𝒪  A - R,augment_rels (dom 𝒮) R ,𝒮W RA L)"
      by (rule flush_step.Ghost)
    hence "(m,sb@xs,𝒪,,𝒮) f (m'',sb''@xs,𝒪'',ℛ'',𝒮'')"
      by (simp add: sb m'' 𝒪'' ℛ'' 𝒮'' )
    also note append_rest
    finally show ?thesis .
  qed
qed
(*
theorem flush_simulates_filter_writes:
  assumes step: "(m,sb,𝒪,ℛ,𝒮) →f (m',sb',𝒪',ℛ',𝒮')"
  shows "⋀sbh 𝒪hh 𝒮h. sb=filter is_Writesb sbh 
          ⟹ 
          ∃sbh' 𝒪h' ℛh' 𝒮h'. (m,sbh,𝒪h,ℛh,𝒮h) →f* (m',sbh',𝒪h',ℛh',𝒮h') ∧ 
  sb'=filter is_Writesb sbh'"
using step
proof (induct rule: flush_step_induct)
  case (Writesb 𝒪' volatile 𝒪 A R 𝒮' 𝒮 W L ℛ' ℛ  m a D f v sb)
  note filter_Writesb = `Writesb volatile a (D,f) v A L R W# sb = filter is_Writesb sbh`
  note 𝒪' = `𝒪' = (if volatile then 𝒪 ∪ A - R else 𝒪)`
  note ℛ' = `ℛ'= (if volatile then empty else ℛ)`
  note 𝒮' = `𝒮' = (if volatile then 𝒮 ⊕W R ⊖A L else 𝒮)`
  from filter_is_Writesb_Cons_Writesb [OF filter_Writesb [symmetric]]
  obtain rs rws where
    rs_reads: "∀r∈set rs. is_Readsb r ∨ is_Progsb r ∨ is_Ghostsb r" and
    sbh: "sbh = rs @ Writesb volatile a (D,f) v A L R W# rws" and 
    sb: "sb = filter is_Writesb rws"
    by blast

  from flush_reads_program [OF rs_reads] obtain 𝒪h' ℛh' 𝒮h' acqh'
  where "(m, rs,𝒪h,ℛh,𝒮h) →f* (m, [],𝒪h',ℛh',𝒮h')" by blast
  from flush_append [OF this]
  have "(m, rs@Writesb volatile a (D,f) v A L R W# rws,𝒪h,ℛh,𝒮h) →f* 
       (m, Writesb volatile a (D,f) v A L R W# rws,𝒪h',ℛh',𝒮h')"
    by simp
  also
  from flush_step.Writesb [OF refl refl refl, of m volatile a "(D,f)" v A L R W rws 𝒪h' ℛh' 𝒮h']
  obtain 𝒪h'' ℛh'' 𝒮h'' 
  where  "(m, Writesb volatile a (D,f) v A L R W# rws,𝒪h',ℛh',𝒮h') →f (m(a:=v), rws, 𝒪h'',ℛh'',𝒮h'')"
    by auto
  finally have "(m, sbh,𝒪h,ℛh,𝒮h) →f* (m(a:=v), rws,𝒪h'',ℛh'',𝒮h'')"
    by (simp add: sbh sb)
  with sb show ?case
    by blast
next
  case (Readsb m volatile a t v sb) 
  note `Readsb volatile a t v # sb = filter is_Writesb sbh`
  from this [symmetric]
  have r_in: "Readsb volatile a t v ∈ set (filter is_Writesb sbh)"
    by auto
  have "∀r ∈ set (filter is_Writesb sbh). is_Writesb r"
    by auto
  from this [rule_format, OF r_in]
  have False by simp
  thus ?case ..
next
  case (Progsb m p1 p2 mis sb)
  note `Progsb p1 p2 mis # sb = filter is_Writesb sbh`
  from this [symmetric]
  have r_in: "Progsb p1 p2 mis ∈ set (filter is_Writesb sbh)"
    by auto
  have "∀r ∈ set (filter is_Writesb sbh). is_Writesb r"
    by auto
  from this [rule_format, OF r_in]
  have False by simp
  thus ?case ..
next
  case (Ghost m A L R W sb)
  note `Ghostsb A L R W# sb = filter is_Writesb sbh`
  from this [symmetric]
  have r_in: "Ghostsb A L R W∈ set (filter is_Writesb sbh)"
    by auto
  have "∀r ∈ set (filter is_Writesb sbh). is_Writesb r"
    by auto
  from this [rule_format, OF r_in]
  have False by simp
  thus ?case ..
qed
*)
(* FIXME: move up *)
lemmas store_buffer_step_induct =  
  store_buffer_step.induct [split_format (complete),
  consumes 1, case_names SBWritesb]
theorem flush_simulates_filter_writes:
  assumes step: "(m,sb,𝒪,,𝒮) w (m',sb',𝒪',ℛ',𝒮')"
  shows "sbh 𝒪h h 𝒮h. sb=filter is_Writesb sbh 
           
          sbh' 𝒪h' h' 𝒮h'. (m,sbh,𝒪h,h,𝒮h) f* (m',sbh',𝒪h',h',𝒮h')  
  sb'=filter is_Writesb sbh'  (sb'=[]  sbh'=[])"
using step
proof (induct rule: store_buffer_step_induct)
  case (SBWritesb m volatile a D f v A L R W sb 𝒪  𝒮)
  note filter_Writesb = ‹Writesb volatile a (D,f) v A L R W# sb = filter is_Writesb sbh
  
  from filter_is_Writesb_Cons_Writesb [OF filter_Writesb [symmetric]]
  obtain rs rws where
    rs_reads: "rset rs. is_Readsb r  is_Progsb r  is_Ghostsb r" and
    sbh: "sbh = rs @ Writesb volatile a (D,f) v A L R W# rws" and 
    sb: "sb = filter is_Writesb rws"
    by blast

  from flush_reads_program [OF rs_reads] obtain 𝒪h' h' 𝒮h' acqh'
  where "(m, rs,𝒪h,h,𝒮h) f* (m, [],𝒪h',h',𝒮h')" by blast
  from flush_append [OF this]
  have "(m, rs@Writesb volatile a (D,f) v A L R W# rws,𝒪h,h,𝒮h) f* 
       (m, Writesb volatile a (D,f) v A L R W# rws,𝒪h',h',𝒮h')"
    by simp
  also
  from flush_step.Writesb [OF refl refl refl, of m volatile a "(D,f)" v A L R W rws 𝒪h' h' 𝒮h']
  obtain 𝒪h'' h'' 𝒮h'' 
  where  "(m, Writesb volatile a (D,f) v A L R W# rws,𝒪h',h',𝒮h') f (m(a:=v), rws, 𝒪h'',h'',𝒮h'')"
    by auto
  finally have steps: "(m, sbh,𝒪h,h,𝒮h) f* (m(a:=v), rws,𝒪h'',h'',𝒮h'')"
    by (simp add: sbh sb)
  show ?case
  proof (cases "sb")
    case Cons
    with steps sb show ?thesis 
      by fastforce
  next  
    case Nil
    from filter_is_Writesb_empty [OF sb [simplified Nil, symmetric]]
    have "rset rws. is_Readsb r  is_Progsb r  is_Ghostsb r".
    from flush_reads_program [OF this] obtain 𝒪h''' h''' 𝒮h''' acqh'''
      where "(m(a:=v), rws,𝒪h'',h'',𝒮h'') f* (m(a:=v), [],𝒪h''',h''',𝒮h''')" by blast
    with steps 
    have "(m, sbh,𝒪h,h,𝒮h) f* (m(a:=v), [],𝒪h''',h''',𝒮h''')" by force
    with sb Nil show ?thesis by fastforce
  qed
qed

lemma bufferd_val_filter_is_Writesb_eq_ext:
  "buffered_val (filter is_Writesb sb) a = buffered_val sb a" 
  by (induct sb) (auto split: memref.splits)

lemma bufferd_val_filter_is_Writesb_eq:
  "buffered_val (filter is_Writesb sb) = buffered_val sb"
  by (rule ext) (rule bufferd_val_filter_is_Writesb_eq_ext)

lemma outstanding_refs_is_volatile_Writesb_filter_writes: 
  "outstanding_refs is_volatile_Writesb (filter is_Writesb xs) = 
   outstanding_refs is_volatile_Writesb xs"
  by (induct xs) (auto simp add: is_volatile_Writesb_def split: memref.splits)

subsection ‹Simulation of Store Buffer Machine without History by Store Buffer Machine with History›

theorem (in valid_program) concurrent_history_steps_simulates_store_buffer_step:
  assumes step_sb: "(ts,m,𝒮) sb (ts',m',𝒮')"
  assumes sim: "ts h tsh"
  shows "tsh' 𝒮h'. (tsh,m,𝒮h) sbh* (tsh',m',𝒮h')  ts' h tsh'"
proof -
  interpret sbh_computation: 
    computation sbh_memop_step flush_step program_step 
       "λp p' is sb. sb @ [Progsb p p' is]" .
  from step_sb
  show ?thesis
  proof (cases rule: concurrent_step_cases)
    case (Memop i _ p "is" θ sb 𝒟 𝒪   _ _ is' θ' sb' _ 𝒟' 𝒪' ℛ')
    then obtain
      ts': "ts' = ts[i := (p, is', θ', sb', 𝒟', 𝒪',ℛ')]" and
      i_bound: "i < length ts" and
      ts_i: "ts ! i = (p, is, θ, sb, 𝒟, 𝒪,)" and
      step_sb: "(is, θ, sb, m, 𝒟, 𝒪, ,𝒮) sb 
                                (is', θ', sb', m', 𝒟', 𝒪', ℛ',𝒮')"
      by auto
  
    from sim obtain 
      lts_eq: "length ts = length tsh" and
      sim_loc: "i < length ts. (𝒪' 𝒟' ℛ'.
            let (p,is, θ, sb,𝒟, 𝒪,) = tsh!i in 
             ts!i=(p,is, θ, filter is_Writesb sb,𝒟',𝒪',ℛ') 
             (filter is_Writesb sb = []  sb=[]))"
      by cases (auto)

    from lts_eq i_bound have i_bound': "i < length tsh"
      by simp

    from step_sb
    show ?thesis
    proof (cases)
      case (SBReadBuffered a v volatile t)
      then obtain
	"is": "is = Read volatile a t#is'" and
	𝒪': "𝒪'=𝒪" and
	𝒮': "𝒮'=𝒮" and
        ℛ': "ℛ'=" and
	𝒟': "𝒟'=𝒟" and
	m': "m'=m" and
	θ': "θ'=θ(tv)" and
	sb': "sb' = sb" and
	buf_val: "buffered_val sb a = Some v"
	by auto
      
      from sim_loc [rule_format, OF i_bound] ts_i "is" 
      obtain sbh 𝒪h h 𝒟h where 
	tsh_i: "tsh!i = (p,Read volatile a t#is',θ,sbh,𝒟h,𝒪h,h)" and
	sb: "sb = filter is_Writesb sbh" and
        sb_empty: "filter is_Writesb sbh = []  sbh=[]"
	by (auto simp add: Let_def)

      from buf_val
      have buf_val': "buffered_val sbh a = Some v"
	by (simp add: bufferd_val_filter_is_Writesb_eq sb)

      let ?tsh_i' = "(p, is', θ(t  v), sbh @ [Readsb volatile a t v], 𝒟h, 𝒪h,h)"
      let ?tsh' = "tsh[i := ?tsh_i']" 
      from sbh_memop_step.SBHReadBuffered [OF buf_val'] 
      have "(Read volatile a t # is', θ, sbh, m,𝒟h, 𝒪h, h,𝒮h) sbh 
            (is', θ(t  v), sbh@ [Readsb volatile a t v], m, 𝒟h, 𝒪h, h, 𝒮h)".
      from sbh_computation.Memop [OF i_bound' tsh_i this] 
      have step: "(tsh, m, 𝒮h) sbh (?tsh', m, 𝒮h)".

      from sb have sb: "sb = filter is_Writesb (sbh @ [Readsb volatile a t v])"
	by simp

      show ?thesis
      proof (cases "filter is_Writesb sbh = []")
        case False

        have "ts [i := (p,is',θ(t  v),sb,𝒟,𝒪,)] h ?tsh'"
          apply (rule sim_history_config.intros)
	  using lts_eq
	  apply  simp
	  using sim_loc i_bound i_bound' sb sb_empty False
	  apply (auto simp add: Let_def nth_list_update)
	  done

        with step show ?thesis
	  by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' θ' 𝒟' sb' ℛ')
      next
        case True
        with sb_empty have empty: "sbh=[]" by simp
        from i_bound' have "?tsh'!i = ?tsh_i'"
          by auto

        
        from sbh_computation.StoreBuffer [OF _ this, simplified empty, simplified, OF _ flush_step.Readsb, of m 𝒮h] i_bound'
        have "(?tsh', m, 𝒮h)
              sbh  (tsh[i := (p, is', θ(t  v), [], 𝒟h, 𝒪h,h)], m, 𝒮h)"
          by (simp add: empty list_update_overwrite)
        with step have "(tsh, m, 𝒮h) sbh*
              (tsh[i := (p, is', θ(t  v), [], 𝒟h, 𝒪h,h)], m,𝒮h)"
          by force
        moreover
        have "ts [i := (p,is',θ(t  v),sb,𝒟,𝒪,)] h tsh[i := (p, is', θ(t  v), [], 𝒟h, 𝒪h,h)]"
          apply (rule sim_history_config.intros)
	  using lts_eq
	  apply  simp
	  using sim_loc i_bound i_bound' sb empty 
	  apply (auto simp add: Let_def nth_list_update)
	  done
        ultimately show ?thesis
	  by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' θ' 𝒟' sb' ℛ')
      qed
    next
      case (SBReadUnbuffered a volatile t)
      then obtain
	"is": "is = Read volatile a t#is'" and
	𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
	𝒮': "𝒮'=𝒮" and
	𝒟': "𝒟'=𝒟" and
	m': "m'=m" and
	θ': "θ'=θ(tm a)" and
	sb': "sb' = sb" and
	buf: "buffered_val sb a = None"
	by auto
    
      from sim_loc [rule_format, OF i_bound] ts_i "is"
      obtain sbh 𝒪h h 𝒟h where 
	tsh_i: "tsh!i = (p,Read volatile a t#is',θ,sbh,𝒟h,𝒪h,h)" and
	sb: "sb = filter is_Writesb sbh" and
        sb_empty: "filter is_Writesb sbh = []  sbh=[]"
	by (auto simp add: Let_def)

      from buf
      have buf': "buffered_val sbh a = None"
	by (simp add: bufferd_val_filter_is_Writesb_eq sb)

      let ?tsh_i' = "(p, is', θ(t  m a), sbh @ [Readsb volatile a t (m a)], 𝒟h, 𝒪h,h)"
      let ?tsh' = "tsh[i := ?tsh_i']" 

      from sbh_memop_step.SBHReadUnbuffered [OF buf']
      have "(Read volatile a t # is',θ, sbh, m, 𝒟h, 𝒪h, h,𝒮h) sbh 
            (is', θ(t  (m a)), sbh@ [Readsb volatile a t (m a)], m,𝒟h, 𝒪h, h,𝒮h)".
      from sbh_computation.Memop [OF i_bound' tsh_i this] 
      have step: "(tsh, m, 𝒮h) sbh 
            (?tsh', m, 𝒮h)".
      moreover 
      from sb have sb: "sb = filter is_Writesb (sbh @ [Readsb volatile a t (m a)])"
	by simp
    
      show ?thesis
      proof (cases "filter is_Writesb sbh = []")
        case False
        have "ts [i := (p,is',θ (tm a),sb,𝒟,𝒪,)] h ?tsh'"
	  apply (rule sim_history_config.intros)
	  using lts_eq
	  apply  simp
	  using sim_loc i_bound i_bound' sb sb_empty False
	  apply (auto simp add: Let_def nth_list_update)
	  done
 
        with step show ?thesis
	  by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' ℛ' 𝒟' θ' sb')
      next
        case True
        with sb_empty have empty: "sbh=[]" by simp
        from i_bound' have "?tsh'!i = ?tsh_i'"
          by auto

        
        from sbh_computation.StoreBuffer [OF _ this, simplified empty, simplified, OF _ flush_step.Readsb, of m 𝒮h] i_bound'
        have "(?tsh', m, 𝒮h)
              sbh  (tsh[i := (p, is', θ(t  (m a)), [], 𝒟h, 𝒪h,h)], m, 𝒮h)"
          by (simp add: empty)
        with step have "(tsh, m, 𝒮h) sbh*
              (tsh[i := (p, is', θ(t  m a), [], 𝒟h, 𝒪h,h)], m, 𝒮h)"
          by force
        moreover
        have "ts [i := (p,is',θ(t  m a),sb,𝒟,𝒪,)] h tsh[i := (p, is', θ(t  m a), [], 𝒟h, 𝒪h,h)]"
          apply (rule sim_history_config.intros)
	  using lts_eq
	  apply  simp
	  using sim_loc i_bound i_bound' sb empty 
	  apply (auto simp add: Let_def nth_list_update)
	  done
        ultimately show ?thesis
	  by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' θ' 𝒟' sb' ℛ')
      qed
    next
      case (SBWriteNonVolatile a D f A L R W)
      then obtain
	"is": "is = Write False a (D, f) A L R W#is'" and
	𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
	𝒮': "𝒮'=𝒮" and
	𝒟': "𝒟'=𝒟" and
	m': "m'=m" and
	θ': "θ'=θ" and
	sb': "sb' = sb@[Writesb False a (D, f) (f θ) A L R W]" 
	by auto

      from sim_loc [rule_format, OF i_bound] ts_i
      obtain sbh 𝒪h h 𝒟h where 
	tsh_i: "tsh!i = (p,Write False a (D,f) A L R W#is',θ,sbh,𝒟h,𝒪h,h)" and
	sb: "sb = filter is_Writesb sbh" 
	by (auto simp add: Let_def "is") 

      from sbh_memop_step.SBHWriteNonVolatile 
      have "(Write False a (D, f) A L R W# is',θ, sbh, m, 𝒟h, 𝒪h, h,𝒮h) sbh 
               (is', θ, sbh @ [Writesb False a (D, f) (f θ) A L R W], m,𝒟h, 𝒪h, h,𝒮h)".
      from sbh_computation.Memop [OF i_bound' tsh_i this] 
      have "(tsh, m, 𝒮h) sbh 
            (tsh[i := (p, is',θ, sbh @ [Writesb False a (D, f) (f θ) A L R W], 𝒟h, 𝒪h,h)],
             m, 𝒮h)".
      moreover
      have "ts [i := (p,is',θ,sb @ [Writesb False a (D,f) (f θ) A L R W],𝒟,𝒪,)] h 
            tsh[i := (p,is',θ, sbh @ [Writesb False a (D,f) (f θ) A L R W],𝒟h, 𝒪h,h)]"
	apply (rule sim_history_config.intros)
	using lts_eq
	apply  simp
	using sim_loc i_bound i_bound' sb 
	apply (auto simp add: Let_def nth_list_update)
	done

      ultimately show ?thesis
	by (auto simp add: 𝒮' m' θ' 𝒪' ℛ' 𝒟' ts' sb')
    next
      case (SBWriteVolatile a D f A L R W)
      then obtain
	"is": "is = Write True a (D, f) A L R W#is'" and
	𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
	𝒮': "𝒮'=𝒮" and
	𝒟': "𝒟'=𝒟" and
	m': "m'=m" and
	θ': "θ'=θ" and
	sb': "sb' = sb@[Writesb True a (D, f) (f θ) A L R W]" 
	by auto

      from sim_loc [rule_format, OF i_bound] ts_i "is"
      obtain sbh 𝒪h h 𝒟h where 
	tsh_i: "tsh!i = (p,Write True a (D,f) A L R W#is',θ,sbh,𝒟h,𝒪h,h)" and
	sb: "sb = filter is_Writesb sbh"
	by (auto simp add: Let_def)

      from sbh_computation.Memop [OF i_bound' tsh_i SBHWriteVolatile 
	]
      have "(tsh, m, 𝒮h) sbh 
            (tsh[i := (p, is',θ, sbh @ [Writesb True a (D, f) (f θ) A L R W], True, 𝒪h,h)],
                m, 𝒮h)".

      moreover
      have "ts [i := (p,is',θ,sb @ [Writesb True a (D,f) (f θ) A L R W],𝒟,𝒪,)] h 
            tsh[i := (p,is', θ, sbh @ [Writesb True a (D,f) (f θ) A L R W],True, 𝒪h,h)]"
	apply (rule sim_history_config.intros)
	using lts_eq
	apply  simp
	using sim_loc i_bound i_bound' sb 
	apply (auto simp add: Let_def nth_list_update)
	done

      ultimately show ?thesis
	by (auto simp add: ts' 𝒪' θ' m' sb' 𝒟' ℛ' 𝒮')
    next
      case SBFence
      then obtain
	"is": "is = Fence #is'" and
	𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
	𝒮': "𝒮'=𝒮" and
	𝒟': "𝒟'=𝒟" and
	m': "m'=m" and
	θ': "θ'=θ" and
	sb: "sb = []" and
	sb': "sb' = []" 
	by auto
      
      from sim_loc [rule_format, OF i_bound] ts_i sb "is"
      obtain sbh 𝒪h h 𝒟h where 
	tsh_i: "tsh!i = (p,Fence # is',θ,sbh,𝒟h,𝒪h,h)" and
	sb: "[] = filter is_Writesb sbh"
	by (auto simp add: Let_def)


      from filter_is_Writesb_empty [OF sb [symmetric]]
      have "r  set sbh. is_Readsb r  is_Progsb r  is_Ghostsb r".

      from flush_reads_program [OF this] obtain 𝒪h' 𝒮h'  h'
      where flsh: "(m, sbh,𝒪h,h,𝒮h) f* (m, [],𝒪h',h',𝒮h')" by blast

      let ?tsh' = "tsh[i := (p,Fence # is', θ, [], 𝒟h, 𝒪h',h')]"
      from sbh_computation.store_buffer_steps [OF flsh i_bound' tsh_i]
      have "(tsh, m, 𝒮h) sbh* (?tsh', m, 𝒮h')".

      also

      from i_bound' have i_bound'': "i < length ?tsh'"
	by auto

      from i_bound' have tsh'_i: "?tsh'!i = (p,Fence#is',θ,[],𝒟h,𝒪h',h')"
	by simp
      from sbh_computation.Memop [OF i_bound'' tsh'_i SBHFence] i_bound'
      have "(?tsh', m, 𝒮h') sbh (tsh[i := (p, is',θ, [], False, 𝒪h',Map.empty)], m,𝒮h')"
	by (simp)
      finally
      have "(tsh, m, 𝒮h) sbh* (tsh[i := (p, is', θ, [],False, 𝒪h',Map.empty)],m, 𝒮h')".

      moreover
    
      have "ts [i := (p,is',θ,[],𝒟,𝒪,)] h tsh[i := (p,is', θ, [],False, 𝒪h',Map.empty)]"
	apply (rule sim_history_config.intros)
	using lts_eq
	apply  simp
	using sim_loc i_bound i_bound' sb 
	apply (auto simp add: Let_def nth_list_update)
	done

      ultimately show ?thesis
	by (auto simp add: ts' 𝒪' θ' m' sb' 𝒟' 𝒮' ℛ')

    next
      case (SBRMWReadOnly cond t a D f ret A L R W)
      then obtain
	"is": "is = RMW a t (D, f) cond ret A L R W#is'" and
	𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
	𝒮': "𝒮'=𝒮" and
	𝒟': "𝒟'=𝒟" and
	m': "m'=m" and
	θ': "θ'=θ(t  m a)" and
	sb: "sb=[]" and
	sb': "sb' = []" and
	cond: "¬ cond (θ(t  m a))"
	by auto      

      from sim_loc [rule_format, OF i_bound] ts_i sb "is"
      obtain sbh 𝒪h h 𝒟h where 
	tsh_i: "tsh!i = (p,RMW a t (D, f) cond ret A L R W# is',θ,sbh,𝒟h,𝒪h,h)" and
	sb: "[] = filter is_Writesb sbh"
	by (auto simp add: Let_def)



      from filter_is_Writesb_empty [OF sb [symmetric]]
      have "r  set sbh. is_Readsb r  is_Progsb r  is_Ghostsb r".

      from flush_reads_program [OF this] obtain 𝒪h' 𝒮h' h'
      where flsh: "(m, sbh,𝒪h,h,𝒮h) f* (m, [],𝒪h',h',𝒮h')" by blast

      let ?tsh' = "tsh[i := (p,RMW a t (D, f) cond ret A L R W# is',θ, [], 𝒟h, 𝒪h',h')]"
      from sbh_computation.store_buffer_steps [OF flsh i_bound' tsh_i]
      have "(tsh, m, 𝒮h) sbh* (?tsh', m, 𝒮h')".

      also

      from i_bound' have i_bound'': "i < length ?tsh'"
	by auto

      from i_bound' have tsh'_i: "?tsh'!i = (p,RMW a t (D, f) cond ret A L R W#is',θ,[],𝒟h,𝒪h',h')"
	by simp

      note step= SBHRMWReadOnly [where cond=cond and θ=θ and m=m, OF cond ] 
      from sbh_computation.Memop [OF i_bound'' tsh'_i step ] i_bound' 
      have "(?tsh', m, 𝒮h') sbh (tsh[i := (p, is',θ(tm a), [], False, 𝒪h',Map.empty)],m, 𝒮h')"
	by (simp)
      finally
      have "(tsh, m, 𝒮h) sbh* (tsh[i := (p, is',θ(tm a), [], False, 𝒪h',Map.empty)],m, 𝒮h')".

      moreover
    
      have "ts [i := (p,is',θ(tm a),[],𝒟,𝒪,)] h tsh[i := (p,is', θ(tm a), [], False, 𝒪h',Map.empty)]"
	apply (rule sim_history_config.intros)
	using lts_eq
	apply  simp
	using sim_loc i_bound i_bound' sb 
	apply (auto simp add: Let_def nth_list_update)
	done

      ultimately show ?thesis
	by (auto simp add: ts' 𝒪' θ' m' sb' 𝒟' 𝒮' ℛ')
    next
      case (SBRMWWrite cond t a D f ret A L R W)
      then obtain
	"is": "is = RMW a t (D, f) cond ret A L R W#is'" and
	𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
	𝒮': "𝒮'=𝒮" and
	𝒟': "𝒟'=𝒟" and
	m': "m'=m(a := f (θ(t  (m a))))" and
	θ': "θ'=θ(t  ret (m a) (f (θ(t  (m a)))))" and
	sb: "sb=[]" and
	sb': "sb' = []" and
	cond: "cond (θ(t  m a))" 
	by auto


      from sim_loc [rule_format, OF i_bound] ts_i sb "is"
      obtain sbh 𝒪h h 𝒟h acqh where 
	tsh_i: "tsh!i = (p,RMW a t (D, f) cond ret A L R W# is',θ,sbh,𝒟h,𝒪h,h)" and
	sb: "[] = filter is_Writesb sbh"
	by (auto simp add: Let_def)

      from filter_is_Writesb_empty [OF sb [symmetric]]
      have "r  set sbh. is_Readsb r  is_Progsb r  is_Ghostsb r".

      from flush_reads_program [OF this] obtain 𝒪h' 𝒮h' h'
      where flsh: "(m, sbh,𝒪h,h,𝒮h) f* (m, [],𝒪h',h',𝒮h')" by blast

      let ?tsh' = "tsh[i := (p,RMW a t (D, f) cond ret A L R W# is',θ, [], 𝒟h, 𝒪h',h')]"

      from sbh_computation.store_buffer_steps [OF flsh i_bound' tsh_i]
      have "(tsh, m, 𝒮h) sbh* (?tsh', m, 𝒮h')".

      also

      from i_bound' have i_bound'': "i < length ?tsh'"
	by auto

      from i_bound' have tsh'_i: "?tsh'!i = (p,RMW a t (D, f) cond ret A L R W#is',θ,[],𝒟h,𝒪h',h')"
	by simp

      note step= SBHRMWWrite [where cond=cond and θ=θ and m=m, OF cond] 
      from sbh_computation.Memop [OF i_bound'' tsh'_i step ] i_bound' 
      have "(?tsh', m, 𝒮h') sbh (tsh[i := (p, is',
	     θ(t  ret (m a) (f (θ(t  (m a))))), [], False, 𝒪h'  A - R,Map.empty)],
	     m(a := f (θ(t  (m a)))),𝒮h'W RA L)"
	by (simp)
      finally
      have "(tsh, m, 𝒮h) sbh* (tsh[i := (p, is',
	     θ(t  ret (m a) (f (θ(t  (m a))))), [], False, 𝒪h'  A - R,Map.empty)],
            m(a := f (θ(t  (m a)))),𝒮h'W RA L)".

      moreover
    
      have "ts [i := (p,is',θ(t  ret (m a) (f (θ(t  (m a))))),[],𝒟,𝒪,)] h 
            tsh[i := (p,is',θ(t  ret (m a) (f (θ(t  (m a))))), [],False, 𝒪h'  A - R,Map.empty)]"
	apply (rule sim_history_config.intros)
	using lts_eq
	apply  simp
	using sim_loc i_bound i_bound' sb 
	apply (auto simp add: Let_def nth_list_update)
	done

      ultimately show ?thesis
	by (auto simp add: ts' 𝒪' θ' m' sb' 𝒟' 𝒮' ℛ')
    next
      case (SBGhost A L R W)
      then obtain
	"is": "is = Ghost A L R W#is'" and
	𝒪': "𝒪'=𝒪" and
        ℛ': "ℛ'=" and
	𝒮': "𝒮'=𝒮" and
	𝒟': "𝒟'=𝒟" and
	m': "m'=m" and
	θ': "θ'=θ" and
	sb': "sb' = sb" 
	by auto

      from sim_loc [rule_format, OF i_bound] ts_i  "is"
      obtain sbh 𝒪h h 𝒟h where 
	tsh_i: "tsh!i = (p,Ghost A L R W# is',θ,sbh,𝒟h,𝒪h,h)" and
	sb: "sb = filter is_Writesb sbh" and
        sb_empty: "filter is_Writesb sbh = []  sbh=[]"
	by (auto simp add: Let_def)

      let ?tsh_i' = "(p, is', θ, sbh@[Ghostsb A L R W],𝒟h, 𝒪h,h)"
      let ?tsh' = "tsh[i := ?tsh_i']" 
      note step= SBHGhost  
      from sbh_computation.Memop [OF i_bound' tsh_i step ] i_bound' 
      have step: "(tsh, m, 𝒮h) sbh (?tsh',m, 𝒮h)"
	by (simp)

      from sb have sb: "sb = filter is_Writesb (sbh @ [Ghostsb A L R W])"
	by simp

      show ?thesis
      proof (cases "filter is_Writesb sbh = []")
        case False

        have "ts [i := (p,is',θ,sb,𝒟,𝒪,)] h ?tsh'"
	  apply (rule sim_history_config.intros)
	  using lts_eq
	  apply  simp
	  using sim_loc i_bound i_bound' sb sb_empty False
	  apply (auto simp add: Let_def nth_list_update)
	  done

        with step show ?thesis
	  by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' 𝒟' θ' sb' ℛ')
      next
        case True
        with sb_empty have empty: "sbh=[]" by simp
        from i_bound' have "?tsh'!i = ?tsh_i'"
          by auto
        from sbh_computation.StoreBuffer [OF _ this, simplified empty, simplified, OF _ flush_step.Ghost, of m 𝒮h] i_bound'
        have "(?tsh', m, 𝒮h)
              sbh  (tsh[i := (p, is', θ, [], 𝒟h, 𝒪h  A - R,augment_rels (dom 𝒮h) R h)], m, 𝒮hW RA L)"
          by (simp add: empty)
        with step have "(tsh, m, 𝒮h) sbh*
              (tsh[i := (p, is', θ, [], 𝒟h, 𝒪h  A - R,augment_rels (dom 𝒮h) R h)], m, 𝒮hW RA L)"
          by force
        moreover
        have "ts [i := (p,is',θ,sb,𝒟,𝒪,)] h 
                 tsh[i := (p, is', θ, [], 𝒟h, 𝒪h  A - R,augment_rels (dom 𝒮h) R h)]"
          apply (rule sim_history_config.intros)
	  using lts_eq
	  apply  simp
	  using sim_loc i_bound i_bound' sb empty 
	  apply (auto simp add: Let_def nth_list_update)
	  done
        ultimately show ?thesis
	  by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' θ' 𝒟' sb' ℛ')
      qed
    qed
  next
    case (Program i _ p "is" θ sb 𝒟 𝒪  p' "is'")
    then obtain 
      ts': "ts' = ts[i := (p', is@is',θ, sb, 𝒟, 𝒪,)]" and
      i_bound: "i < length ts" and
      ts_i: "ts ! i = (p, is, θ,sb,𝒟, 𝒪,)" and
      prog_step: "θ p p (p', is')" and
      𝒮': "𝒮'=𝒮" and
      m': "m'=m"
      by auto

    from sim obtain 
      lts_eq: "length ts = length tsh" and
      sim_loc: "i < length ts. (𝒪' 𝒟' ℛ'. 
            let (p,is,θ, sb, 𝒟, 𝒪,) = tsh!i in ts!i=(p,is, θ, filter is_Writesb sb,𝒟',𝒪',ℛ') 
                (filter is_Writesb sb = []  sb = []))"
      by cases auto

    from sim_loc [rule_format, OF i_bound] ts_i 
      obtain sbh 𝒪h h 𝒟h acqh where 
	tsh_i: "tsh!i = (p,is,θ,sbh,𝒟h,𝒪h,h)" and
	sb: "sb = filter is_Writesb sbh" and
        sb_empty: "filter is_Writesb sbh = []  sbh=[]"
	by (auto simp add: Let_def)

    from lts_eq i_bound have i_bound': "i < length tsh"
      by simp
   
    let ?tsh_i' = "(p', is @ is',θ, sbh @ [Progsb p p' is'], 𝒟h, 𝒪h,h)"
      let ?tsh' = "tsh[i := ?tsh_i']" 
    from sbh_computation.Program [OF i_bound' tsh_i prog_step]
    have step: "(tsh, m, 𝒮h) sbh (?tsh',m, 𝒮h)".
    
    show ?thesis
    proof (cases "filter is_Writesb sbh = []")
      case False
      have "ts[i := (p', is@is', θ, sb,𝒟, 𝒪,)] h ?tsh'"
        apply (rule sim_history_config.intros)
        using lts_eq
        apply  simp
        using sim_loc i_bound i_bound' sb False sb_empty
        apply (auto simp add: Let_def nth_list_update)
        done
      
      with step show ?thesis
        by (auto simp add: ts' 𝒮' m')
    next
      case True
      with sb_empty have empty: "sbh=[]" by simp
      from i_bound' have "?tsh'!i = ?tsh_i'"
        by auto
      
      from sbh_computation.StoreBuffer [OF _ this, simplified empty, simplified, OF _ flush_step.Progsb, of m 𝒮h] i_bound'
      have "(?tsh', m, 𝒮h)
              sbh  (tsh[i := (p', is@is', θ, [], 𝒟h, 𝒪h,h)], m, 𝒮h)"
        by (simp add: empty)
      with step have "(tsh, m, 𝒮h) sbh*
           (tsh[i := (p', is@is', θ, [], 𝒟h, 𝒪h,h)], m, 𝒮h) "
        by force
      moreover
      have "ts[i := (p', is@is', θ, sb,𝒟, 𝒪,)] h tsh[i := (p', is@is', θ, [], 𝒟h, 𝒪h,h)]"
        apply (rule sim_history_config.intros)
	using lts_eq
	apply  simp
	using sim_loc i_bound i_bound' sb empty 
	apply (auto simp add: Let_def nth_list_update)
	done
      ultimately show ?thesis
        by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts')
    qed
  next
    case (StoreBuffer i _ p "is" θ sb 𝒟 𝒪   _ _ _ sb' 𝒪' ℛ')
    then obtain 
      ts': "ts' = ts[i := (p, is,θ, sb', 𝒟, 𝒪',ℛ')]" and
      i_bound: "i < length ts" and
      ts_i: "ts ! i = (p, is,θ,sb, 𝒟, 𝒪,)" and
      sb_step: "(m,sb,𝒪,,𝒮) w (m', sb',𝒪',ℛ',𝒮')" 
      by auto

    from sim obtain
      lts_eq: "length ts = length tsh" and
      sim_loc: "i < length ts. (𝒪' 𝒟' ℛ'. 
            let (p,is, θ, sb,𝒟, 𝒪,) = tsh!i in ts!i=(p,is, θ, filter is_Writesb sb,𝒟',𝒪',ℛ') 
                (filter is_Writesb sb = []  sb=[]))"
      by cases auto

    from sim_loc [rule_format, OF i_bound] ts_i 
      obtain sbh 𝒪h h 𝒟h acqh where 
	tsh_i: "tsh!i = (p,is,θ,sbh,𝒟h,𝒪h,h)" and
	sb: "sb = filter is_Writesb sbh" and        
        sb_empty: "filter is_Writesb sbh = []  sbh=[]"
	by (auto simp add: Let_def)

    from lts_eq i_bound have i_bound': "i < length tsh"
      by simp

    from flush_simulates_filter_writes [OF sb_step sb, of 𝒪h h 𝒮h] 
    obtain sbh' 𝒪h' h' 𝒮h' 
      where flush': "(m, sbh,𝒪h,h,𝒮h) f* (m', sbh',𝒪h',h',𝒮h')" and 
      sb': "sb' = filter is_Writesb sbh'" and
      sb'_empty: "filter is_Writesb sbh' = []  sbh'=[]"
      by auto

    from sb_step obtain volatile a sop v A L R W where "sb=Writesb volatile a sop v A L R W#sb'"
      by cases force
    from sbh_computation.store_buffer_steps [OF flush' i_bound' tsh_i]
    have "(tsh, m, 𝒮h) sbh* (tsh[i := (p, is, θ, sbh',𝒟h, 𝒪h',h')], m', 𝒮h')".
    
    moreover
    have "ts[i := (p, is, θ, sb',𝒟, 𝒪',ℛ')] h 
          tsh[i := (p, is, θ, sbh',𝒟h, 𝒪h',h')]"
      apply (rule sim_history_config.intros)
      using lts_eq
      apply  simp
      using sim_loc i_bound i_bound' sb sb' sb'_empty
      apply (auto simp add: Let_def nth_list_update)
      done

    ultimately show ?thesis
      by (auto simp add: ts' )
  qed
qed



theorem (in valid_program) concurrent_history_steps_simulates_store_buffer_steps:
  assumes step_sb: "(ts,m,𝒮) sb*  (ts',m',𝒮')"
  shows "tsh 𝒮h. ts h tsh  tsh' 𝒮h'. (tsh,m,𝒮h) sbh* (tsh',m',𝒮h')  ts' h tsh'"
using step_sb
proof (induct rule: converse_rtranclp_induct_sbh_steps) 
  case refl thus ?case by auto
next
  case (step ts m 𝒮  ts'' m'' 𝒮'' )
  have first: "(ts,m,𝒮) sb  (ts'',m'',𝒮'')" by fact
  have sim: "ts h tsh" by fact
  from concurrent_history_steps_simulates_store_buffer_step [OF first sim, of 𝒮h]
  obtain tsh'' 𝒮h'' where
    exec: "(tsh,m,𝒮h) sbh* (tsh'',m'',𝒮h'')" and  sim: "ts'' h tsh''"
    by auto
  from step.hyps (3) [OF sim, of 𝒮h'']
  obtain tsh' 𝒮h' where exec_rest: "(tsh'',m'',𝒮h'')  sbh* (tsh',m',𝒮h')" and sim': "ts' h tsh'"
    by auto
  note exec also note exec_rest
  finally show ?case
  using sim' by blast
qed

theorem (in xvalid_program_progress) concurrent_direct_execution_simulates_store_buffer_execution:
assumes exec_sb: "(tssb,msb,x) sb* (tssb',msb',x')"
assumes init: "initialsb tssb 𝒮sb"
assumes valid: "valid tssb" (* FIXME: move into initial ?*)
assumes sim: "(tssb,msb,𝒮sb)  (ts,m,𝒮)"
assumes safe: "safe_reach_direct safe_free_flowing (ts,m,𝒮)"
shows "tsh' 𝒮h' ts' m' 𝒮'. 
          (tssb,msb,𝒮sb) sbh* (tsh',msb',𝒮h') 
               tssb' h tsh' 
          (ts,m,𝒮) d* (ts',m',𝒮')  
                (tsh',msb',𝒮h')  (ts',m',𝒮')"
proof -
  from init interpret ini: initialsb tssb 𝒮sb .
  from concurrent_history_steps_simulates_store_buffer_steps [OF exec_sb ini.history_refl, of 𝒮sb]
  obtain tsh' 𝒮h' where
    sbh: "(tssb,msb,𝒮sb) sbh* (tsh',msb',𝒮h')" and
    sim_sbh: "tssb' h tsh'"
    by auto
  from concurrent_direct_execution_simulates_store_buffer_history_execution [OF sbh init valid sim safe]
  obtain ts' m' 𝒮' where
    d: "(ts,m,𝒮) d* (ts',m',𝒮')" and
    d_sim: "(tsh',msb',𝒮h')  (ts',m',𝒮')"
    by auto
  with sbh sim_sbh show ?thesis by blast
qed

  

inductive sim_direct_config:: 
 "('p,'p store_buffer,'dirty,'owns,'rels) thread_config list  ('p,unit,bool,'owns','rels') thread_config list  bool" 
  ("_ d _ " [60,60] 100)
where
  "length ts = length tsd; 
    i < length ts. 
         (𝒪' 𝒟' ℛ'.
           let (p,is, θ,sb,𝒟, 𝒪,) = tsd!i in 
                ts!i=(p,is, θ, [] ,𝒟',𝒪',ℛ'))
    
     
     ts d tsd"

lemma empty_sb_sims: 
assumes empty:
  "i p is xs sb 𝒟 𝒪 . i < length tssb  tssb!i=(p,is,xs,sb,𝒟,𝒪,) sb=[]"
assumes sim_h: "tssb h tsh"
assumes sim_d: "(tsh,mh,𝒮h)  (ts,m,𝒮)"
shows "tssb d ts  mh=m  length tssb = length ts"
proof-
  from sim_h empty
  have empty':
  "i p is xs sb 𝒟 𝒪 . i < length tsh  tsh!i=(p,is,xs,sb,𝒟,𝒪,) sb=[]"
    apply (cases)
    apply clarsimp
    subgoal for i
    apply (drule_tac x=i in spec)
    apply (auto simp add: Let_def)
    done
    done
  from sim_h sim_config_emptyE [OF empty' sim_d]
  show ?thesis
    apply cases
    apply clarsimp
    apply (rule sim_direct_config.intros)
    apply  clarsimp
    apply clarsimp
    using empty'
    subgoal for i
    apply (drule_tac x=i in spec)
    apply (drule_tac x=i in spec)
    apply (drule_tac x=i in spec)
    apply (auto simp add: Let_def)
    done
    done
qed

lemma empty_d_sims:
assumes sim: "tssb d ts"
shows "tsh. tssb h tsh  (tsh,m,𝒮)  (ts,m,𝒮)"
proof -
  from sim obtain
    leq: "length tssb = length ts" and
    sim: "i < length tssb. 
         (𝒪' 𝒟' ℛ'.
           let (p,is, θ,sb,𝒟, 𝒪,) = ts!i in 
                tssb!i=(p,is, θ, [] ,𝒟',𝒪',ℛ'))"
    by cases auto
  define tsh where "tsh  map (λ(p,is, θ,sb,𝒟, 𝒪,). (p,is, θ,[]::'a memref list,𝒟, 𝒪,)) ts" 
  have "tssb h tsh"
    apply (rule sim_history_config.intros)
    using leq sim
    apply (auto simp add: tsh_def Let_def leq)
    done
  moreover
  have empty:
  "i p is xs sb 𝒟 𝒪 . i < length tsh  tsh!i=(p,is,xs,sb,𝒟,𝒪,) sb=[]"
    apply (clarsimp simp add: tsh_def Let_def)
    subgoal for i
    apply (case_tac "ts!i")
    apply auto
    done
    done
  
  have "(tsh,m,𝒮)  (ts,m,𝒮)"
    apply (rule sim_config_emptyI [OF empty])
    apply  (clarsimp simp add: tsh_def)
    apply (clarsimp simp add: tsh_def Let_def)
    subgoal for i
    apply (case_tac "ts!i")
    apply auto
    done
    done
  ultimately show ?thesis by blast
qed


theorem (in xvalid_program_progress) concurrent_direct_execution_simulates_store_buffer_execution_empty:
assumes exec_sb: "(tssb,msb,x) sb* (tssb',msb',x')"
assumes init: "initialsb tssb 𝒮sb"
assumes valid: "valid tssb" (* FIXME: move into initial ?*)
assumes empty: 
  "i p is xs sb 𝒟 𝒪 . i < length tssb'  tssb'!i=(p,is,xs,sb,𝒟,𝒪,) sb=[]"
assumes sim: "(tssb,msb,𝒮sb)  (ts,m,𝒮)"
assumes safe: "safe_reach_direct safe_free_flowing (ts,m,𝒮)"
shows "ts' 𝒮'. 
          (ts,m,𝒮) d* (ts',msb',𝒮')  tssb' d ts'"
proof -
  from concurrent_direct_execution_simulates_store_buffer_execution [OF exec_sb init valid sim safe]
  obtain tsh' 𝒮h' ts' m' 𝒮' where
    "(tssb,msb,𝒮sb) sbh* (tsh',msb',𝒮h')" and
    sim_h: "tssb' h tsh'" and
    exec: "(ts,m,𝒮) d* (ts',m',𝒮')" and
    sim: "(tsh',msb',𝒮h')  (ts',m',𝒮')"
    by auto
  from empty_sb_sims [OF empty sim_h sim]
  obtain "tssb' d ts'" "msb' = m'" "length tssb' = length ts'"
    by auto
  thus ?thesis
    using exec
    by blast
qed

locale initiald = simple_ownership_distinct + read_only_unowned + unowned_shared +
fixes valid
assumes empty_is: "i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,)  is=[]"
assumes empty_rels: "i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,)  =Map.empty"
assumes valid_init: "valid (map (λ(p,is, θ,sb,𝒟, 𝒪,). (p,is, θ,[],𝒟, 𝒪,)) ts)"

locale empty_store_buffers =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes empty_sb: "i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,)  sb=[]"

lemma initial_d_sb:
  assumes init: "initiald ts 𝒮 valid"
  shows "initialsb (map (λ(p,is, θ,sb,𝒟, 𝒪,). (p,is, θ,[],𝒟, 𝒪,)) ts) 𝒮" 
         (is "initialsb ?map 𝒮")
proof -
  from init interpret ini: initiald ts 𝒮 .
  show ?thesis
  proof (intro_locales)
    show "simple_ownership_distinct ?map"
    apply (clarsimp simp add: simple_ownership_distinct_def)
    subgoal for i j
    apply (case_tac "ts!i")
    apply (case_tac "ts!j")
    apply (cut_tac i=i and j=j in ini.simple_ownership_distinct)
    apply      clarsimp
    apply     clarsimp
    apply    clarsimp
    apply   assumption
    apply  assumption
    apply auto
    done
    done
  next
    show "read_only_unowned 𝒮 ?map"
    apply (clarsimp simp add: read_only_unowned_def)
    subgoal for i
    apply (case_tac "ts!i")
    apply (cut_tac i=i in ini.read_only_unowned)
    apply   clarsimp
    apply  assumption
    apply auto
    done
    done
  next
    show "unowned_shared 𝒮 ?map"
    apply (clarsimp simp add: unowned_shared_def')
    apply (rule ini.unowned_shared')
    apply clarsimp
    subgoal for a i
    apply (case_tac "ts!i")
    apply auto
    done
    done
  next
    show "initialsb_axioms ?map"
    apply (unfold_locales)
            subgoal for i
            apply (case_tac "ts!i")
            apply simp
            done
           subgoal for i
           apply  (case_tac "ts!i")
           apply  clarsimp
           apply  (rule_tac i=i in ini.empty_is)
           apply   clarsimp
           apply  fastforce
           done
    subgoal for i
    apply (case_tac "ts!i")
    apply clarsimp
    apply (rule_tac i=i in ini.empty_rels)
    apply  clarsimp
    apply fastforce
    done
    done
  qed
qed

theorem (in xvalid_program_progress) store_buffer_execution_result_sequential_consistent:
assumes exec_sb: "(tssb,m,x) sb* (tssb',m',x')"
assumes empty': "empty_store_buffers tssb'"
assumes sim: "tssb d ts"
assumes init: "initiald ts 𝒮 valid"
assumes safe: "safe_reach_direct safe_free_flowing (ts,m,𝒮)"
shows "ts' 𝒮'. 
          (ts,m,𝒮) d* (ts',m',𝒮')  tssb' d ts'"
proof -
  from empty'
  have empty': 
  "i p is xs sb 𝒟 𝒪 . i < length tssb'  tssb'!i=(p,is,xs,sb,𝒟,𝒪,) sb=[]"
    by (auto simp add: empty_store_buffers_def)

  define tsh where "tsh  map (λ(p,is, θ,sb,𝒟, 𝒪,). (p,is, θ,[]::'a memref list,𝒟, 𝒪,)) ts" 
  from initial_d_sb [OF init]
  have init_h:"initialsb tsh 𝒮"
    by (simp add: tsh_def)
  from initiald.valid_init [OF init]
  have valid_h: "valid tsh"
    by (simp add: tsh_def)
  from sim obtain
    leq: "length tssb = length ts" and
    sim: "i < length tssb. 
         (𝒪' 𝒟' ℛ'.
           let (p,is, θ,sb,𝒟, 𝒪,) = ts!i in 
                tssb!i=(p,is, θ, [] ,𝒟',𝒪',ℛ'))"
    by cases auto
  have sim_h: "tssb h tsh"
    apply (rule sim_history_config.intros)
    using leq sim
    apply (auto simp add: tsh_def Let_def leq)
    done

  from concurrent_history_steps_simulates_store_buffer_steps [OF exec_sb sim_h, of 𝒮]
  obtain tsh' 𝒮h' where steps_h: "(tsh,m,𝒮) sbh* (tsh',m',𝒮h')" and
     sim_h': "tssb' h tsh'"
    by auto

  moreover
  have empty:
  "i p is xs sb 𝒟 𝒪 . i < length tsh  tsh!i=(p,is,xs,sb,𝒟,𝒪,) sb=[]"
    apply (clarsimp simp add: tsh_def Let_def)
    subgoal for i
    apply (case_tac "ts!i")
    apply auto
    done
    done
  
  have sim': "(tsh,m,𝒮)  (ts,m,𝒮)"
    apply (rule sim_config_emptyI [OF empty])
    apply  (clarsimp simp add: tsh_def)
    apply (clarsimp simp add: tsh_def Let_def)
    subgoal for i
    apply (case_tac "ts!i")
    apply auto
    done
  done

  from concurrent_direct_execution_simulates_store_buffer_history_execution [OF steps_h init_h valid_h sim' safe]
  obtain ts' m'' 𝒮'' where steps: "(ts, m, 𝒮) d* (ts', m'', 𝒮'')" 
    and sim': "(tsh', m', 𝒮h')  (ts', m'', 𝒮'')"
    by blast
  from empty_sb_sims [OF empty' sim_h' sim'] steps
  show ?thesis
    by auto
qed


locale initialv = simple_ownership_distinct + read_only_unowned + unowned_shared +
fixes valid
assumes empty_is: "i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,)  is=[]"
assumes valid_init: "valid (map (λ(p,is, θ,sb,𝒟, 𝒪,). (p,is, θ,[],𝒟, 𝒪,Map.empty)) ts)"

(*
term "initialv"
context xvalid_program_progress
begin
term "safe_reach safe_free_flowing (ts,m,𝒮)"
theorem (in xvalid_program_progress) store_buffer_execution_result_sequential_consistent':
assumes exec_sb: "(tssb,m,x) ⇒sb* (tssb',m',x')"
assumes sim: "tssbd ts"

assumes safe: " safe_reach safe_free_flowing (ts,m,𝒮)"
shows "∃ts' 𝒮'. 
          (ts,m,𝒮) ⇒v* (ts',m',𝒮') "
*)



theorem (in xvalid_program_progress) store_buffer_execution_result_sequential_consistent':
assumes exec_sb: "(tssb,m,x) sb* (tssb',m',x')"
assumes empty': "empty_store_buffers tssb'"
assumes sim: "tssb d ts"
assumes init: "initialv ts 𝒮 valid"
assumes safe: "safe_reach_virtual safe_free_flowing (ts,m,𝒮)"
shows "ts' 𝒮'. 
          (ts,m,𝒮) v* (ts',m',𝒮')  tssb' d ts'"
proof -
  define tsd where "tsd == (map (λ(p,is, θ,sb,𝒟, 𝒪,ℛ'). (p,is, θ,sb,𝒟, 𝒪,Map.empty::rels)) ts)"
  have rem_ts: "remove_rels tsd = ts"
    apply (rule nth_equalityI)
    apply  (simp add: tsd_def remove_rels_def)
    apply (clarsimp simp add: tsd_def remove_rels_def)
    subgoal for i
    apply (case_tac "ts!i")
    apply clarsimp
    done
    done
  from sim
  have sim': "tssb d tsd"
    apply cases
    apply (rule sim_direct_config.intros)
    apply (auto simp add: tsd_def)
    done
  
  have init': "initiald tsd 𝒮 valid"
  proof (intro_locales)
    from init have "simple_ownership_distinct ts"
      by (simp add: initialv_def)
    then
    show "simple_ownership_distinct tsd"
      apply (clarsimp simp add: tsd_def simple_ownership_distinct_def)
      subgoal for i j
      apply (case_tac "ts!i")
      apply (case_tac "ts!j")
      apply force
      done
      done
  next
    from init have "read_only_unowned 𝒮 ts"
      by (simp add: initialv_def)
    then show "read_only_unowned 𝒮 tsd"
      apply (clarsimp simp add: tsd_def read_only_unowned_def)
      subgoal for i
      apply (case_tac "ts!i")
      apply force
      done
      done
  next
    from init have "unowned_shared 𝒮 ts"
      by (simp add: initialv_def)
    then 
    show "unowned_shared 𝒮 tsd"
      apply (clarsimp simp add: tsd_def unowned_shared_def)
      apply force
      done
  next
    have eq: "((λ(p, is, θ, sb, 𝒟, 𝒪, ). (p, is, θ, [], 𝒟, 𝒪, )) 
              (λ(p, is, θ, sb, 𝒟, 𝒪, ℛ'). (p, is, θ, (), 𝒟, 𝒪, Map.empty))) 
     = (λ(p, is, θ, sb, 𝒟, 𝒪, ℛ'). (p, is, θ, [], 𝒟, 𝒪, Map.empty))"
      apply (rule ext)
      subgoal for x
      apply (case_tac x)
      apply auto
      done
      done
    from init have "initialv_axioms ts valid"
      by (simp add: initialv_def)
     
    then
    show "initiald_axioms tsd valid"
      apply (clarsimp simp add: tsd_def initialv_axioms_def initiald_axioms_def eq)
      apply (rule conjI)
      apply  clarsimp
             subgoal for i
             apply (case_tac "ts!i")
             apply force
             done
      apply clarsimp
      subgoal for i
      apply (case_tac "ts!i")
      apply force
      done
      done
  qed

  {
    fix tsd' m' 𝒮'
    assume exec: "(tsd, m, 𝒮) d* (tsd', m', 𝒮')"
    have "safe_free_flowing (tsd', m', 𝒮')"
    proof -
      from virtual_simulates_direct_steps [OF exec]
      have exec_v: "(ts, m, 𝒮) v* (remove_rels tsd', m', 𝒮')"
        by (simp add: rem_ts)
      have eq: "map (owned 
                    (λ(p, is, θ, sb, 𝒟, 𝒪, ). (p, is, θ, (), 𝒟, 𝒪, ())))
                tsd' = map owned tsd'"
        by auto
      from exec_v safe
      have "safe_free_flowing (remove_rels tsd', m', 𝒮')"
        by (auto simp add: safe_reach_def)
      then show ?thesis
        by (auto simp add: safe_free_flowing_def remove_rels_def owned_def eq)
    qed
  }
  hence safe': "safe_reach_direct safe_free_flowing (tsd, m, 𝒮)"
    by (simp add: safe_reach_def)
          
  from store_buffer_execution_result_sequential_consistent [OF exec_sb empty' sim' init' safe'] 
  obtain tsd' 𝒮' where
     exec_d: "(tsd, m, 𝒮) d* (tsd', m', 𝒮')"  and sim_d: "tssb' d tsd'"
    by blast

  from virtual_simulates_direct_steps [OF exec_d]
  have "(ts, m, 𝒮) v* (remove_rels tsd', m', 𝒮')"
    by (simp add: rem_ts)
  moreover
  from sim_d
  have "tssb' d remove_rels tsd'"
    apply (cases)
    apply (rule sim_direct_config.intros)
    apply (auto simp add: remove_rels_def)
    done
  ultimately show ?thesis
    by auto
qed

subsection ‹Plug Together the Two Simulations›

corollary (in xvalid_program) concurrent_direct_steps_simulates_store_buffer_step:
  assumes step_sb: "(tssb,msb,𝒮sb) sb (tssb',msb',𝒮sb')"
  assumes sim_h: "tssb h tssbh"
  assumes sim: "(tssbh,msb,𝒮sbh)  (ts,m,𝒮) "
  assumes valid_own: "valid_ownership 𝒮sbh tssbh"
  assumes valid_sb_reads: "valid_reads msb tssbh"
  assumes valid_hist: "valid_history program_step tssbh"
  assumes valid_sharing: "valid_sharing 𝒮sbh tssbh"
  assumes tmps_distinct: "tmps_distinct tssbh"
  assumes valid_sops: "valid_sops tssbh"
  assumes valid_dd: "valid_data_dependency tssbh"
  assumes load_tmps_fresh: "load_tmps_fresh tssbh"
  assumes enough_flushs: "enough_flushs tssbh"
  assumes valid_program_history: "valid_program_history tssbh"
  assumes valid: "valid tssbh"
  assumes safe_reach: "safe_reach_direct safe_delayed (ts,m,𝒮)"
  shows "tssbh' 𝒮sbh'. 
         (tssbh,msb,𝒮sbh) sbh* (tssbh',msb',𝒮sbh')  tssb' h tssbh' 
         valid_ownership 𝒮sbh' tssbh'  valid_reads msb' tssbh'  
         valid_history program_step tssbh' 
         valid_sharing 𝒮sbh' tssbh'  tmps_distinct tssbh'  valid_data_dependency tssbh' 
         valid_sops tssbh'  load_tmps_fresh tssbh'  enough_flushs tssbh' 
         valid_program_history tssbh'  valid tssbh' 
           (ts' 𝒮' m'. (ts,m,𝒮) d* (ts',m',𝒮')  
            (tssbh',msb',𝒮sbh')  (ts',m',𝒮'))"
proof -
  from concurrent_history_steps_simulates_store_buffer_step [OF step_sb sim_h]
  obtain tssbh' 𝒮sbh' where
    steps_h: "(tssbh,msb,𝒮sbh) sbh* (tssbh',msb',𝒮sbh')" and
    sim_h': "tssb' h tssbh'"
    by blast
  moreover
  from concurrent_direct_steps_simulates_store_buffer_history_steps [OF steps_h
  valid_own valid_sb_reads valid_hist valid_sharing tmps_distinct valid_sops valid_dd
  load_tmps_fresh enough_flushs valid_program_history valid sim safe_reach]
  obtain m' ts' 𝒮' where
    "(ts,m,𝒮) d* (ts',m',𝒮')" "(tssbh', msb',𝒮sbh')  (ts', m', 𝒮')"
    "valid_ownership 𝒮sbh' tssbh'" "valid_reads msb' tssbh'" "valid_history program_step tssbh'"
    "valid_sharing 𝒮sbh' tssbh'" "tmps_distinct tssbh'" "valid_data_dependency tssbh'"
    "valid_sops tssbh'" "load_tmps_fresh tssbh'" "enough_flushs tssbh'"
    "valid_program_history tssbh'" "valid tssbh'"
    by blast
  ultimately
  show ?thesis
    by blast
qed

(* ******************* Some tuned version for presentations ********************************** *)

lemma conj_commI: "P  Q  Q  P"
  by simp
lemma def_to_eq: "P = Q  P  Q"
  by simp

context xvalid_program
begin

definition 
"invariant ts 𝒮 m  
  valid_ownership 𝒮 ts  valid_reads m ts  valid_history program_step ts  
  valid_sharing 𝒮 ts  tmps_distinct ts  valid_data_dependency ts  
  valid_sops ts   load_tmps_fresh ts  enough_flushs ts  valid_program_history ts  
  valid ts"

definition "ownership_inv  valid_ownership" 
definition "sharing_inv   valid_sharing"
definition "temporaries_inv ts  tmps_distinct ts  load_tmps_fresh ts"
definition "history_inv ts m  valid_history program_step ts  valid_program_history ts  valid_reads m ts"
definition "data_dependency_inv ts  valid_data_dependency ts  load_tmps_fresh ts  valid_sops ts"
definition "barrier_inv  enough_flushs" 

lemma invariant_grouped_def: "invariant ts 𝒮 m 
 ownership_inv 𝒮 ts  sharing_inv 𝒮 ts  temporaries_inv ts  data_dependency_inv ts  history_inv ts m  barrier_inv ts  valid ts"
  apply (rule def_to_eq)
  apply (auto simp add: ownership_inv_def sharing_inv_def barrier_inv_def temporaries_inv_def history_inv_def data_dependency_inv_def invariant_def)
  done


theorem (in xvalid_program) simulation':
  assumes step_sb: "(tssb,msb,𝒮sb) sbh (tssb',msb',𝒮sb')"
  assumes sim: "(tssb,msb,𝒮sb)  (ts,m,𝒮)"
  assumes inv: "invariant tssb 𝒮sb msb"
  assumes safe_reach: "safe_reach_direct safe_delayed (ts,m,𝒮)"
  shows "invariant tssb' 𝒮sb' msb' 
           (ts' 𝒮' m'. (ts,m,𝒮) d* (ts',m',𝒮')  (tssb',msb',𝒮sb')  (ts',m',𝒮'))"
  using inv sim safe_reach
  apply (unfold invariant_def)
  apply (simp only: conj_assoc)
  apply (rule "concurrent_direct_steps_simulates_store_buffer_history_step" [OF step_sb])
  apply simp_all
  done

lemmas (in xvalid_program) simulation = conj_commI [OF simulation']
end

end

Theory PIMP

(* Copyright (C) 2007--2010 Norbert Schirmer
 * All rights reserved, DFKI GmbH 
 *)
(*
header {* Parallel - IMP *}
*)

subsection ‹PIMP›

theory PIMP
imports ReduceStoreBufferSimulation
begin

datatype expr = Const val | Mem bool addr | Tmp sop
              | Unop "val  val" expr 
              | Binop "val  val  val" expr expr
(* Hmm. addr's should be vals ? *)
datatype stmt = 
                Skip 
              | Assign bool expr expr "tmps  owns" "tmps  owns" "tmps  owns" "tmps  owns" 
              | CAS expr expr expr "tmps  owns" "tmps  owns" "tmps  owns" "tmps  owns" 
              | Seq "stmt" "stmt"
              | Cond expr "stmt" "stmt"
              | While  expr "stmt" 


              | SGhost "tmps  owns" "tmps  owns" "tmps  owns" "tmps  owns"
              | SFence

(*
FIXME:
Genralisation of Assignment and CAS (and SGhost) would be nice:
  * A L R W sets not just dependent on value of addr, but on tmps 
    (beware of domain: thm program_step_tmps_mono) or some ghost state
*)
primrec used_tmps:: "expr  nat" ― ‹number of temporaries used›
where
"used_tmps (Const v) = 0"
| "used_tmps (Mem volatile addr) = 1"
| "used_tmps (Tmp sop) = 0"
| "used_tmps (Unop f e) = used_tmps e"
| "used_tmps (Binop f e1 e2) = used_tmps e1 + used_tmps e2"

primrec issue_expr:: "tmp  expr  instr list" ― ‹load operations›
where
"issue_expr t (Const v) = []"
|"issue_expr t (Mem volatile a) = [Read volatile a t]"
|"issue_expr t (Tmp sop) = []"
|"issue_expr t (Unop f e) = issue_expr t e"
|"issue_expr t (Binop f e1 e2) = issue_expr t e1 @ issue_expr (t + (used_tmps e1)) e2" 

primrec eval_expr:: "tmp  expr  sop" ― ‹calculate result›
where
"eval_expr t (Const v) = ({},λθ. v)"
|"eval_expr t (Mem volatile a) = ({t},λθ. the (θ t))"
|"eval_expr t (Tmp sop) = sop"
(*
"eval_expr t (Tmp sop) = ({i. i ∈ fst sop ∧ i < t}, λθ. snd sop (θ |`{i. i ∈ fst sop ∧ i < t}))"*)
                         ― ‹trick to enforce sop to be sensible in the current context, without
                               having to include wellformedness constraints›
|"eval_expr t (Unop f e) = (let (D,fe) = eval_expr t e in (D,λθ. f (fe θ))) "
|"eval_expr t (Binop f e1 e2) = (let (D1,f1) = eval_expr t e1;
                                    (D2,f2) = eval_expr (t + (used_tmps e1)) e2  
                                in (D1  D2,λθ. f (f1 θ) (f2 θ)))" 

primrec valid_sops_expr:: "nat  expr  bool"
where
"valid_sops_expr t (Const v) = True"
|"valid_sops_expr t (Mem volatile a) = True"
|"valid_sops_expr t (Tmp sop) = ((t'  fst sop. t' < t)  valid_sop sop)"
|"valid_sops_expr t (Unop f e) = valid_sops_expr t e"
|"valid_sops_expr t (Binop f e1 e2) = (valid_sops_expr t e1  valid_sops_expr t e2)" 


primrec valid_sops_stmt:: "nat  stmt  bool"
where
"valid_sops_stmt t Skip = True"
|"valid_sops_stmt t (Assign volatile a e A L R W) = (valid_sops_expr t a  valid_sops_expr t e)"
|"valid_sops_stmt t (CAS a ce se A L R W) = (valid_sops_expr t a  valid_sops_expr t ce  
                                            valid_sops_expr t se)"
|"valid_sops_stmt t (Seq s1 s2) = (valid_sops_stmt t s1  valid_sops_stmt t s2)"
|"valid_sops_stmt t (Cond e s1 s2) = (valid_sops_expr t e  valid_sops_stmt t s1  valid_sops_stmt t s2)"
|"valid_sops_stmt t (While e s) = (valid_sops_expr t e  valid_sops_stmt t s)"
|"valid_sops_stmt t (SGhost A L R W) = True"
|"valid_sops_stmt t SFence = True"

  
type_synonym stmt_config = "stmt × nat"
consts isTrue:: "val  bool"

inductive stmt_step:: "tmps  stmt_config   stmt_config × instrs   bool" 
  ("_ _ s _" [60,60,60] 100)
for θ
where

  AssignAddr:
  "sop. a  Tmp sop  
   θ (Assign volatile a e A L R W, t) s 
         ((Assign volatile (Tmp (eval_expr t a)) e A L R W, t + used_tmps a), issue_expr t a)"

|  Assign:
  "D  dom θ  
   θ (Assign volatile (Tmp (D,a)) e A L R W, t) s 
         ((Skip, t + used_tmps e), 
           issue_expr t e@[Write volatile (a θ) (eval_expr t e) (A θ) (L θ) (R θ) (W θ)])"


| CASAddr:
  "sop. a  Tmp sop  
   θ (CAS a ce se A L R W, t) s 
         ((CAS (Tmp (eval_expr t a)) ce se A L R W, t + used_tmps a), issue_expr t a)"


| CASComp:
  "sop. ce  Tmp sop  
   θ (CAS (Tmp (Da,a)) ce se A L R W, t) s 
         ((CAS (Tmp (Da,a)) (Tmp (eval_expr t ce)) se A L R W, t + used_tmps ce), issue_expr t ce)"

| CAS:
  "Da  dom θ; Dc  dom θ; eval_expr t se  = (D,f)   
   
   θ (CAS (Tmp (Da,a)) (Tmp (Dc,c)) se A L R W, t) s 
         ((Skip, Suc (t + used_tmps se)), issue_expr t se@
           [RMW (a θ) (t + used_tmps se) (D,f) (λθ. the (θ (t + used_tmps se)) = c θ) (λv1 v2. v1) 
            (A θ) (L θ) (R θ) (W θ) ])"

| Seq:
  "θ (s1, t) s ((s1', t'), is) 
    
   θ (Seq s1 s2, t) s ((Seq s1' s2, t'),is)"

| SeqSkip:
  "θ (Seq Skip s2, t) s ((s2, t), [])"


| Cond:
  "sop. e  Tmp sop 
   
   θ (Cond e s1 s2, t) s 
    ((Cond (Tmp (eval_expr t e)) s1 s2, t + used_tmps e), issue_expr t e)"

| CondTrue:
  "D  dom θ; isTrue (e θ) 
    
   θ (Cond (Tmp (D,e)) s1 s2, t) s ((s1, t),[])"

| CondFalse:
  "D  dom θ; ¬ isTrue (e θ) 
    
   θ (Cond (Tmp (D,e)) s1 s2, t) s ((s2, t),[])"

| While:
  "θ (While e s, t) s 
   ((Cond e (Seq s (While e s)) Skip, t),[])"

| SGhost:
  "θ (SGhost A L R W, t) s ((Skip, t),[Ghost (A θ) (L θ) (R θ) (W θ)])"

| SFence:
  "θ (SFence, t) s ((Skip, t),[Fence])"

inductive_cases stmt_step_cases [cases set]:
"θ (Skip, t) s c"
"θ (Assign volatile a e A L R W, t) s c"
"θ (CAS a ce se A L R W, t) s c"
"θ (Seq s1 s2, t) s c"
"θ (Cond e s1 s2, t) s c"
"θ (While e s, t) s c"
"θ (SGhost A L R W, t) s c"
"θ (SFence, t) s c"

lemma valid_sops_expr_mono: "t t'. valid_sops_expr t e  t  t'   valid_sops_expr t' e"
  by (induct e) auto

lemma valid_sops_stmt_mono: "t t'.  valid_sops_stmt t s  t  t'   valid_sops_stmt t' s"
  by (induct s) (auto intro: valid_sops_expr_mono)

lemma valid_sops_expr_valid_sop: "t. valid_sops_expr t e  valid_sop (eval_expr t e)"
proof (induct e)
  case (Unop f e)
  then obtain "valid_sops_expr t e"
    by simp
  from Unop.hyps [OF this]
  have vs: "valid_sop (eval_expr t e)"
    by simp
  obtain D g where eval_e: "eval_expr t e = (D,g)"
    by (cases "eval_expr t e")

  interpret valid_sop "(D,g)"
    using vs eval_e
    by simp

  show ?case
    apply (clarsimp simp add: Let_def valid_sop_def eval_e)
    apply (drule valid_sop [OF refl])
    apply simp
    done
next
  case (Binop f e1 e2)
  then obtain v1: "valid_sops_expr t e1" and v2: "valid_sops_expr t e2"
    by simp
  with Binop.hyps (1) [of t]  Binop.hyps (2) [of "(t + used_tmps e1)"]  
    valid_sops_expr_mono [OF v2, of "(t + used_tmps e1)"]
  obtain vs1: "valid_sop (eval_expr t e1)" and vs2: "valid_sop (eval_expr (t + used_tmps e1) e2)"
    by auto
  obtain D1 g1 where eval_e1: "eval_expr t e1 = (D1,g1)"
    by (cases "eval_expr t e1")
  obtain D2 g2 where eval_e2: "eval_expr (t + used_tmps e1) e2 = (D2,g2)"
    by (cases "eval_expr (t + used_tmps e1) e2")
  interpret vs1: valid_sop "(D1,g1)"
    using vs1 eval_e1 by auto
  interpret vs2: valid_sop "(D2,g2)"
    using vs2 eval_e2 by auto
  {
    fix θ:: "natval option" 
    assume D1: "D1  dom θ" 
    assume D2: "D2  dom θ"
    have "f (g1 θ) (g2 θ) = f (g1 (θ |` (D1  D2))) (g2 (θ |` (D1  D2)))"
    proof -
      from vs1.valid_sop [OF refl D1]
      have "g1 θ = g1 (θ |` D1)".
      also
      from D1 have D1': "D1  dom (θ |` (D1  D2))"
	by auto
      have "θ |` (D1  D2) |` D1 = θ |` D1"
	apply (rule ext)
	apply (auto simp add: restrict_map_def)
	done
      with vs1.valid_sop [OF refl D1']
      have "g1 (θ |` D1) = g1 (θ |` (D1  D2))"
	by auto
      finally have g1: "g1 (θ |` (D1  D2)) = g1 θ"
	by simp

      from vs2.valid_sop [OF refl D2]
      have "g2 θ = g2 (θ |` D2)".
      also
      from D2 have D2': "D2  dom (θ |` (D1  D2))"
	by auto
      have "θ |` (D1  D2) |` D2 = θ |` D2"
	apply (rule ext)
	apply (auto simp add: restrict_map_def)
	done
      with vs2.valid_sop [OF refl D2']
      have "g2 (θ |` D2) = g2 (θ |` (D1  D2))"
	by auto
      finally have g2: "g2 (θ |` (D1  D2)) = g2 θ"
	by simp

      from g1 g2 show ?thesis by simp
    qed
  }
      
  note lem=this
  show ?case
    apply (clarsimp simp add: Let_def valid_sop_def eval_e1 eval_e2)
    apply (rule lem)
    by auto
qed (auto simp add: valid_sop_def)

lemma valid_sops_expr_eval_expr_in_range: 
  "t. valid_sops_expr t e  t'  fst (eval_expr t e). t' < t + used_tmps e"
proof (induct e)
  case (Unop f e)
  thus ?case
    apply (cases "eval_expr t e")
    apply auto
    done
next
  case (Binop f e1 e2)
  then obtain v1: "valid_sops_expr t e1" and v2: "valid_sops_expr t e2"
    by simp
  from valid_sops_expr_mono [OF v2]
  have v2': "valid_sops_expr (t + used_tmps e1) e2"
    by auto
  from Binop.hyps (1) [OF v1] Binop.hyps (2) [OF v2']
  show ?case
    apply (cases "eval_expr t e1")
    apply (cases "eval_expr (t + used_tmps e1) e2")
    apply auto
    done
qed auto



lemma stmt_step_tmps_count_mono:
  assumes step: "θ (s,t) s ((s',t'),is)"
  shows "t  t'"
using step
by (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct) force+
  

lemma valid_sops_stmt_invariant:
  assumes step: "θ (s,t) s ((s',t'),is)"
  shows "valid_sops_stmt t s  valid_sops_stmt t' s'"
using step
proof (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
  case AssignAddr thus ?case by 
  (force simp add: valid_sops_expr_valid_sop intro: valid_sops_stmt_mono valid_sops_expr_mono  
     dest: valid_sops_expr_eval_expr_in_range)
next
  case Assign thus ?case by simp
next
  case CASAddr thus ?case by 
  (force simp add: valid_sops_expr_valid_sop intro: valid_sops_stmt_mono valid_sops_expr_mono  
     dest: valid_sops_expr_eval_expr_in_range)
next
  case CASComp thus ?case by 
  (force simp add: valid_sops_expr_valid_sop intro: valid_sops_stmt_mono valid_sops_expr_mono  
     dest: valid_sops_expr_eval_expr_in_range)
next
  case CAS thus ?case by simp
next
  case Seq thus ?case by (force intro: valid_sops_stmt_mono dest: stmt_step_tmps_count_mono)
next
  case SeqSkip thus ?case by auto
next
  case Cond thus ?case 
    by (fastforce simp add: valid_sops_expr_valid_sop intro: valid_sops_stmt_mono 
     dest: valid_sops_expr_eval_expr_in_range)
next
  case CondTrue thus ?case by force
next
  case CondFalse thus ?case by force
next
  case While thus ?case by auto
next
  case SGhost thus ?case by simp
next
  case SFence thus ?case by simp
qed


lemma map_le_restrict_map_eq: "m1 m m2  D  dom m1  m2 |` D = m1 |` D"
  apply (rule ext)
  apply (force simp add: restrict_map_def map_le_def)
  done


lemma sbh_step_preserves_load_tmps_bound: 
  assumes step: "(is,𝒪,𝒟,θ,sb,𝒮,m) sbh (is',𝒪',𝒟',θ',sb',𝒮',m')"
  assumes less: "i  load_tmps is. i < n" 
  shows "i  load_tmps is'. i < n"
  using step less
  by cases auto

lemma sbh_step_preserves_read_tmps_bound:
  assumes step: "(is,θ,sb,m,𝒟,𝒪,𝒮) sbh (is',θ',sb',m',𝒟',𝒪',𝒮')"
  assumes less_is: "i  load_tmps is. i < n" 
  assumes less_sb: "i  read_tmps sb. i < n" 
  shows "i  read_tmps sb'. i < n"
  using step less_is less_sb
  by cases (auto simp add: read_tmps_append)

lemma sbh_step_preserves_tmps_bound:
  assumes step: "(is,θ,sb,m,𝒟,𝒪,𝒮) sbh (is',θ',sb',m',𝒟',𝒪',𝒮')"
  assumes less_dom: "i  dom θ. i < n" 
  assumes less_is: "i  load_tmps is. i < n" 
  shows "i  dom θ'. i < n"
  using step less_dom  less_is
  by cases (auto simp add: read_tmps_append)

lemma flush_step_preserves_read_tmps:
  assumes step: "(m,sb,𝒪) f (m',sb',𝒪')"
  assumes less_sb: "i  read_tmps sb. i < n" 
  shows "i  read_tmps sb'. i < n"
  using step less_sb
  by cases (auto simp add: read_tmps_append)

lemma flush_step_preserves_write_sops:
  assumes step: "(m,sb,𝒪) f (m',sb',𝒪')"
  assumes less_sb: "i(fst ` write_sops sb). i < t" 
  shows "i(fst ` write_sops sb'). i < t"
  using step less_sb
  by cases (auto simp add: read_tmps_append)

lemma issue_expr_load_tmps_range': 
  "t. load_tmps (issue_expr t e) = {i. t  i  i < t + used_tmps e}"
apply (induct e)
apply (force simp add: load_tmps_append)+
done


lemma issue_expr_load_tmps_range: 
  "t. i  load_tmps (issue_expr t e). t  i  i < t + (used_tmps e)"
by (auto simp add: issue_expr_load_tmps_range')


lemma stmt_step_load_tmps_range':
  assumes step: "θ (s, t) s ((s', t'),is)"
  shows "load_tmps is = {i. t  i  i < t'}"
  using step 
  apply (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
  apply (force simp add: load_tmps_append simp add: issue_expr_load_tmps_range')+
  done


lemma stmt_step_load_tmps_range:
  assumes step: "θ (s, t) s ((s', t'),is)"
  shows "i  load_tmps is. t  i  i < t'"
using stmt_step_load_tmps_range' [OF step]
by auto


lemma distinct_load_tmps_issue_expr: "t. distinct_load_tmps (issue_expr t e)"
  apply (induct e)
  apply (auto simp add: distinct_load_tmps_append dest!: issue_expr_load_tmps_range [rule_format])
  done

lemma max_used_load_tmps: "t + used_tmps e  load_tmps (issue_expr t e)"
proof -
  from issue_expr_load_tmps_range [rule_format, of "t+used_tmps e"]
  show ?thesis
    by auto
qed

lemma stmt_step_distinct_load_tmps:
  assumes step: "θ (s, t) s ((s', t'),is)"
  shows "distinct_load_tmps is"
  using step 
  apply (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
  apply (force simp add: distinct_load_tmps_append distinct_load_tmps_issue_expr max_used_load_tmps)+  
  done

lemma store_sops_issue_expr [simp]: "t. store_sops (issue_expr t e) = {}"
  apply (induct e)
  apply (auto simp add: store_sops_append)
  done


lemma stmt_step_data_store_sops_range:
  assumes step: "θ (s, t) s ((s', t'),is)"
  assumes valid: "valid_sops_stmt t s"
  shows "(D,f)  store_sops is. i  D. i < t'"
using step valid
proof (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
  case AssignAddr
  thus ?case
    by auto
next
  case (Assign D volatile a e)
  thus ?case
    apply (cases "eval_expr t e")
    apply (auto simp add: store_sops_append intro: valid_sops_expr_eval_expr_in_range [rule_format])
    done
next
  case CASAddr
  thus ?case
    by auto
next
  case CASComp
  thus ?case
    by auto
next
  case (CAS _ _ D f a A L R)
  thus ?case
    by (fastforce simp add: store_sops_append dest: valid_sops_expr_eval_expr_in_range [rule_format])
next
  case Seq
  thus ?case
    by (force intro: valid_sops_stmt_mono )
next
  case SeqSkip thus ?case by simp
next
  case Cond thus ?case
    by auto
next
  case CondTrue thus ?case by auto
next
  case CondFalse thus ?case by auto
next
  case While thus ?case by auto
next
  case SGhost thus ?case by auto
next
  case SFence thus ?case by auto
qed

lemma sbh_step_distinct_load_tmps_prog_step: 
      assumes step: "θ(s,t) s ((s',t'),is')"
  assumes load_tmps_le: "i  load_tmps is. i < t"
  assumes read_tmps_le: "i  read_tmps sb. i < t"
  shows "distinct_load_tmps is'  (load_tmps is'  load_tmps is = {}) 
         (load_tmps is'  read_tmps sb) = {}"
proof - 
  from stmt_step_load_tmps_range [OF step] stmt_step_distinct_load_tmps [OF step] 
    load_tmps_le read_tmps_le
  show ?thesis
    by force
qed


lemma data_dependency_consistent_instrs_issue_expr: 
  "t T. data_dependency_consistent_instrs T (issue_expr t e)"
  apply (induct e)
  apply (auto simp add: data_dependency_consistent_instrs_append 
    dest!: issue_expr_load_tmps_range [rule_format] 
    )
  done

lemma dom_eval_expr:
  "t. valid_sops_expr t e; x  fst (eval_expr t e)  x  {i. i < t}  load_tmps (issue_expr t e)"
proof (induct e)
  case Const thus ?case by simp
next
  case Mem thus ?case by simp
next
  case Tmp thus ?case by simp
next
  case (Unop f e)
  thus ?case
    by (cases "eval_expr t e") auto
next
  case (Binop f e1 e2)
  then obtain valid1: "valid_sops_expr t e1" and valid2: "valid_sops_expr t e2"
    by auto
  from valid_sops_expr_mono [OF valid2] have valid2': "valid_sops_expr (t+used_tmps e1) e2"
    by auto

  from Binop.hyps (1) [OF valid1] Binop.hyps (2) [OF valid2'] Binop.prems
  show ?case
    apply (case_tac "eval_expr t e1")
    apply (case_tac "eval_expr (t+used_tmps e1) e2")
    apply (auto simp add: load_tmps_append issue_expr_load_tmps_range')
    done
qed


lemma Cond_not_s1: "s1  Cond e s1 s2 " 
  by (induct s1) auto

lemma Cond_not_s2: "s2  Cond e s1 s2 " 
  by (induct s2) auto

lemma Seq_not_s1: "s1  Seq s1 s2"
  by (induct s1) auto

lemma Seq_not_s2: "s2  Seq s1 s2"
  by (induct s2) auto

lemma prog_step_progress:
  assumes step: "θ(s,t) s ((s',t'),is)"
  shows "(s',t')  (s,t)  is  []"
using step 
proof (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
  case (AssignAddr a _ _ _ _ _ _ t) thus ?case 
    by (cases "eval_expr t a") auto
next
  case Assign thus ?case by auto
next
  case (CASAddr a _ _ _ _ _ _ t) thus ?case by (cases "eval_expr t a") auto 
next
  case (CASComp ce _ _ _ _ _ _ _ t) thus ?case by (cases "eval_expr t ce") auto  
next
  case CAS thus ?case by auto
next
  case (Cond e _ _ t) thus ?case by (cases "eval_expr t e") auto  
next
  case CondTrue thus ?case using Cond_not_s1 by auto
next
  case CondFalse thus ?case using Cond_not_s2 by auto
next
  case Seq thus ?case by force
next
  case SeqSkip thus ?case using Seq_not_s2 by auto
next
  case While thus ?case by auto
next
  case SGhost thus ?case by auto
next
  case SFence thus ?case by auto
qed

lemma stmt_step_data_dependency_consistent_instrs:
  assumes step: "θ (s, t) s ((s', t'),is)"
  assumes valid: "valid_sops_stmt t s"
  shows "data_dependency_consistent_instrs ({i. i < t}) is"
  using step valid 
proof (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" T rule: stmt_step.induct)
  case AssignAddr
  thus ?case
    by (fastforce simp add: simp add: data_dependency_consistent_instrs_append 
    data_dependency_consistent_instrs_issue_expr load_tmps_append
    dest: dom_eval_expr)
next
  case Assign
  thus ?case
    by (fastforce simp add: simp add: data_dependency_consistent_instrs_append 
    data_dependency_consistent_instrs_issue_expr load_tmps_append
    dest: dom_eval_expr)
next
  case CASAddr
  thus ?case
    by (fastforce simp add: simp add: data_dependency_consistent_instrs_append 
    data_dependency_consistent_instrs_issue_expr load_tmps_append
    dest: dom_eval_expr)
next
  case CASComp
  thus ?case
    by (fastforce simp add: simp add: data_dependency_consistent_instrs_append 
    data_dependency_consistent_instrs_issue_expr load_tmps_append
    dest: dom_eval_expr)
next
  case CAS
  thus ?case
    by (fastforce simp add: simp add: data_dependency_consistent_instrs_append 
      data_dependency_consistent_instrs_issue_expr load_tmps_append
      dest: dom_eval_expr)
next
  case Seq
  thus ?case
    by (fastforce simp add: simp add: data_dependency_consistent_instrs_append)
next
  case SeqSkip thus ?case by auto
next
  case Cond
  thus ?case
    by (fastforce simp add: simp add: data_dependency_consistent_instrs_append 
      data_dependency_consistent_instrs_issue_expr load_tmps_append
      dest: dom_eval_expr)
next
  case CondTrue thus ?case by auto
next
  case CondFalse thus ?case by auto
next
  case While
  thus ?case by auto
next
  case SGhost thus ?case by auto
next
  case SFence thus ?case by auto
qed



lemma sbh_valid_data_dependency_prog_step: 
  assumes step: "θ(s,t) s ((s',t'),is')"
  assumes store_sops_le: "i  (fst ` store_sops is). i < t"
  assumes write_sops_le: "i  (fst ` write_sops sb). i < t"
  assumes valid: "valid_sops_stmt t s"
  shows "data_dependency_consistent_instrs ({i. i < t}) is'  
         load_tmps is'  (fst ` store_sops is)  = {} 
         load_tmps is'  (fst ` write_sops sb)  = {}"
proof -
  from stmt_step_data_dependency_consistent_instrs [OF step valid] stmt_step_load_tmps_range [OF step]
  store_sops_le write_sops_le
  show ?thesis
    by fastforce
qed

lemma sbh_load_tmps_fresh_prog_step:
  assumes step: "θ(s,t) s ((s',t'),is')"
  assumes tmps_le: "i  dom θ. i < t"
  shows "load_tmps is'  dom θ = {}"
proof -
  from stmt_step_load_tmps_range [OF step] tmps_le
  show ?thesis
    apply auto
    subgoal for x
    apply (drule_tac x=x in bspec )
    apply  assumption
    apply (drule_tac x=x in bspec )
    apply  fastforce
    apply simp
    done
    done
qed

lemma sbh_valid_sops_prog_step:
  assumes step: "θ(s,t) s ((s',t'),is)"
  assumes valid: "valid_sops_stmt t s"
  shows "sopstore_sops is. valid_sop sop"
using step valid
proof (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
  case AssignAddr
  thus ?case by auto
next
  case Assign
  thus ?case
    by (auto simp add: store_sops_append valid_sops_expr_valid_sop)
next
  case CASAddr
  thus ?case by auto
next
  case CASComp
  thus ?case by auto
next
  case CAS
  thus ?case
    by (fastforce simp add: store_sops_append dest: valid_sops_expr_valid_sop)
next
  case Seq
  thus ?case
    by (force intro: valid_sops_stmt_mono )
next
  case SeqSkip thus ?case by simp
next
  case Cond thus ?case
    by auto
next
  case CondTrue thus ?case by auto
next
  case CondFalse thus ?case by auto
next
  case While thus ?case by auto
next
  case SGhost thus ?case by auto
next
  case SFence thus ?case by auto
qed

primrec prog_configs:: "'a memref list  'a set"
where
"prog_configs [] = {}"
|"prog_configs (x#xs) = (case x of 
                         Progsb p p' is  {p,p'}  prog_configs xs
                       | _  prog_configs xs)"

lemma prog_configs_append: "ys. prog_configs (xs@ys) = prog_configs xs  prog_configs ys"
  by (induct xs) (auto split: memref.splits)

lemma prog_configs_in1: "Progsb p1 p2 is  set xs  p1  prog_configs xs"
  by (induct xs) (auto split: memref.splits)

lemma prog_configs_in2: "Progsb p1 p2 is  set xs  p2  prog_configs xs"
  by (induct xs) (auto split: memref.splits)

lemma prog_configs_mono: "ys. set xs  set ys  prog_configs xs  prog_configs ys"
  by (induct xs) (auto split: memref.splits simp add: prog_configs_append
  prog_configs_in1 prog_configs_in2)

locale separated_tmps = 
fixes ts
assumes valid_sops_stmt: "i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪) 
   valid_sops_stmt t s"
assumes valid_sops_stmt_sb: "i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪); (s',t')  prog_configs sb 
    valid_sops_stmt t' s'"
assumes load_tmps_le: "i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪) 
   i  load_tmps is. i < t"
assumes read_tmps_le: "i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪) 
   i  read_tmps sb. i < t"
assumes store_sops_le: "i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪) 
   i  (fst ` store_sops is). i < t"
assumes write_sops_le: "i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪) 
   i  (fst ` write_sops sb). i < t"
assumes tmps_le: "i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪) 
   dom θ  load_tmps is = {i. i < t}"

lemma (in separated_tmps)
  tmps_le': 
  assumes i_bound: "i < length ts" 
  assumes ts_i: "ts!i = ((s,t),is,θ,sb,𝒟,𝒪)"
  shows "i  dom θ. i < t"
using tmps_le [OF i_bound ts_i] by auto



lemma (in separated_tmps) separated_tmps_nth_update: 
  "i < length ts; valid_sops_stmt t s; (s',t')  prog_configs sb. valid_sops_stmt t' s'; 
   i  load_tmps is. i < t;i  read_tmps sb. i < t;
    i  (fst ` store_sops is). i < t; i  (fst ` write_sops sb). i < t; dom θ  load_tmps is = {i. i < t} 
   
   separated_tmps (ts[i:=((s,t),is,θ,sb,𝒟,𝒪)])"
  apply (unfold_locales)
  apply       (force intro: valid_sops_stmt  simp add: nth_list_update split: if_split_asm)
  apply      (fastforce intro: valid_sops_stmt_sb  simp add: nth_list_update split: if_split_asm)
  apply     (fastforce intro: load_tmps_le [rule_format] simp add: nth_list_update split: if_split_asm)
  apply    (fastforce intro: read_tmps_le [rule_format] simp add: nth_list_update split: if_split_asm)
  apply   (fastforce intro: store_sops_le [rule_format] simp add: nth_list_update split: if_split_asm)
  apply  (fastforce intro: write_sops_le [rule_format] simp add: nth_list_update split: if_split_asm)
  apply (fastforce dest: tmps_le [rule_format] simp add: nth_list_update split: if_split_asm)
  done

lemma hd_prog_app_in_first: "ys. Progsb p p' is  set xs  hd_prog q (xs @ ys) = hd_prog q xs"
  by (induct xs) (auto split: memref.splits)

lemma hd_prog_app_in_eq: "ys. Progsb p p' is  set xs  hd_prog q xs = hd_prog x xs"
  by (induct xs) (auto split: memref.splits)

lemma hd_prog_app_notin_first: "ys. p p' is. Progsb p p' is  set xs  hd_prog q (xs @ ys) = hd_prog q ys"
  by (induct xs) (auto split: memref.splits)

lemma union_eq_subsetD: "A  B = C  A  B  C   C  A  B"
  by auto

lemma prog_step_preserves_separated_tmps:
  assumes i_bound: "i < length ts"  
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪)" 
  assumes prog_step: "θ p s (p', is')"
  assumes sep: "separated_tmps ts"
  shows "separated_tmps 
             (ts [i:=(p',is@is',θ,sb@[Progsb p p' is'],𝒟,𝒪)])"
proof -
  obtain s t where p: "p=(s,t)" by (cases p)
  obtain s' t' where p': "p'=(s',t')" by (cases p')
  note ts_i = ts_i [simplified p]
  note step = prog_step [simplified p p']
  interpret separated_tmps ts by fact
  have "separated_tmps (ts[i := ((s',t'), is @ is', θ, 
    sb @ [Progsb (s,t) (s',t') is'], 𝒟,𝒪)])"
  proof (rule separated_tmps_nth_update [OF i_bound])
    from stmt_step_load_tmps_range [OF step] load_tmps_le [OF i_bound ts_i]
    stmt_step_tmps_count_mono [OF step]
    show "iload_tmps (is @ is'). i < t'"
      by (auto simp add: load_tmps_append)
  next
    from read_tmps_le [OF i_bound ts_i] stmt_step_tmps_count_mono [OF step]
    show "iread_tmps (sb @ [Progsb (s, t) (s', t') is']). i < t'"
      by (auto simp add: read_tmps_append)
  next
    from stmt_step_data_store_sops_range [OF step] stmt_step_tmps_count_mono [OF step]
    store_sops_le [OF i_bound ts_i] valid_sops_stmt [OF i_bound ts_i]
    show "i(fst ` store_sops (is @ is')). i < t'"
      by (fastforce simp add: store_sops_append)
  next
    from 
      stmt_step_tmps_count_mono [OF step] write_sops_le [OF i_bound ts_i]
    show "i(fst ` write_sops (sb @ [Progsb (s, t) (s', t') is'])). i < t'"
      by (fastforce simp add: write_sops_append)
  next
    from tmps_le [OF i_bound ts_i] 
    have "dom θ  load_tmps is = {i. i < t}" by simp
    with stmt_step_load_tmps_range' [OF step] stmt_step_tmps_count_mono [OF step]
    show "dom θ  load_tmps (is @ is') = {i. i < t'}"
      apply (clarsimp simp add: load_tmps_append)
      apply rule
      apply  (drule union_eq_subsetD)
      apply  fastforce
      apply clarsimp
      subgoal for x
      apply (case_tac "t  x")
      apply  simp
      apply (subgoal_tac "x < t")
      apply  fastforce
      apply fastforce
      done
      done
  next
    from valid_sops_stmt_invariant [OF prog_step [simplified p p'] valid_sops_stmt [OF i_bound ts_i]]
    show "valid_sops_stmt t' s'".
  next
    show "(s', t')prog_configs (sb @ [Progsb (s, t) (s', t') is']).
             valid_sops_stmt t' s'"
    proof -
      {
	fix s1 t1 
	assume cfgs: "(s1,t1)  prog_configs (sb @ [Progsb (s, t) (s', t') is'])"
	have "valid_sops_stmt t1 s1"
	proof -
	  from valid_sops_stmt [OF i_bound ts_i]
	  have "valid_sops_stmt t s".
	  moreover
	  from valid_sops_stmt_invariant [OF prog_step [simplified p p'] valid_sops_stmt [OF i_bound ts_i]]
	  have "valid_sops_stmt t' s'".
	  moreover
	  note valid_sops_stmt_sb [OF i_bound ts_i]
	  ultimately
	  show ?thesis
	    using cfgs
	    by (auto simp add: prog_configs_append)
	qed
      }
      thus ?thesis
	by auto
    qed
  qed
  then
  show ?thesis
    by (simp add: p p')
qed

lemma flush_step_sb_subset:
  assumes step: "(m,sb,𝒪) f (m', sb',𝒪')"
  shows "set sb'  set sb"
using step
apply (induct c1=="(m,sb,𝒪)" c2=="(m',sb',𝒪')" arbitrary: m sb 𝒪 acq m' sb' 𝒪' acq
  rule: flush_step.induct)
apply auto
done

lemma flush_step_preserves_separated_tmps:
  assumes i_bound: "i < length ts"  
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)" 
  assumes flush_step: "(m,sb,𝒪,,𝒮) f (m', sb',𝒪',ℛ',𝒮')"
  assumes sep: "separated_tmps ts"
  shows "separated_tmps (ts [i:=(p,is,θ,sb',𝒟,𝒪',ℛ')])"
proof -
  obtain s t where p: "p=(s,t)" by (cases p)
  note ts_i = ts_i [simplified p]
  interpret separated_tmps ts by fact
  have "separated_tmps (ts [i:=((s,t),is,θ,sb',𝒟,𝒪',ℛ')])"
  proof (rule separated_tmps_nth_update [OF i_bound])
    from load_tmps_le [OF i_bound ts_i]
    show "iload_tmps is. i < t".
  next
    from flush_step_preserves_read_tmps [OF flush_step read_tmps_le [OF i_bound ts_i] ]
    show "iread_tmps sb'. i < t".
  next
    from store_sops_le [OF i_bound ts_i]
    show "i(fst ` store_sops is). i < t".
  next
    from flush_step_preserves_write_sops [OF flush_step write_sops_le [OF i_bound ts_i]]
    show "i(fst ` write_sops sb'). i < t".
  next
    from tmps_le [OF i_bound ts_i] 
    show "dom θ  load_tmps is = {i. i < t}"
      by auto
  next
    from valid_sops_stmt [OF i_bound ts_i]
    show "valid_sops_stmt t s".
  next
    from valid_sops_stmt_sb [OF i_bound ts_i] flush_step_sb_subset [OF flush_step]
    show "(s', t')prog_configs sb'. valid_sops_stmt t' s'"
      by (auto dest!: prog_configs_mono)
  qed
  then
  show ?thesis
    by (simp add: p)
qed

lemma sbh_step_preserves_store_sops_bound:
  assumes step: "(is,θ,sb,m,𝒟,𝒪,,𝒮) sbh (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮')"
  assumes store_sops_le: "i(fst ` store_sops is). i < t"
  shows "i(fst ` store_sops is'). i < t"
  using step store_sops_le
  by cases auto

lemma sbh_step_preserves_write_sops_bound:
  assumes step: "(is,θ,sb,m,𝒟,𝒪,,𝒮) sbh (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮')"
  assumes store_sops_le: "i(fst ` store_sops is). i < t"
  assumes write_sops_le: "i(fst ` write_sops sb). i < t"
  shows "i(fst ` write_sops sb'). i < t"
  using step store_sops_le write_sops_le
  by cases (auto simp add: write_sops_append)

lemma sbh_step_prog_configs_eq:
  assumes step: "(is,θ,sb,m,𝒟,𝒪,,𝒮) sbh (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮')"
  shows "prog_configs sb' = prog_configs sb"
using step
apply (cases)
apply (auto simp add: prog_configs_append)
done

lemma sbh_step_preserves_tmps_bound':
  assumes step: "(is,θ,sb,m,𝒟,𝒪,,𝒮) sbh (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮')"
  shows "dom θ  load_tmps is = dom θ'  load_tmps is'"
  using step 
  apply cases 
  apply (auto simp add: read_tmps_append)
  done

lemma sbh_step_preserves_separated_tmps:
  assumes i_bound: "i < length ts" 
  assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,)" 
  assumes memop_step: "(is, θ, sb, m,𝒟, 𝒪, ,𝒮) sbh 
                        (is', θ', sb', m',𝒟', 𝒪', ℛ',𝒮')" 
  assumes instr: "separated_tmps ts"
  shows "separated_tmps (ts [i:=(p,is',θ',sb',𝒟',𝒪',ℛ')])"
proof -
  obtain s t where p: "p=(s,t)" by (cases p)
  note ts_i = ts_i [simplified p]
  interpret separated_tmps ts by fact
  have "separated_tmps (ts [i:=((s,t),is',θ',sb',𝒟',𝒪',ℛ')])"
  proof (rule separated_tmps_nth_update [OF i_bound])
    from sbh_step_preserves_load_tmps_bound [OF memop_step load_tmps_le [OF i_bound ts_i]]
    show "iload_tmps is'. i < t".
  next
    from sbh_step_preserves_read_tmps_bound [OF memop_step load_tmps_le [OF i_bound ts_i]
        read_tmps_le [OF i_bound ts_i]]
    show "iread_tmps sb'. i < t".
  next
    from sbh_step_preserves_store_sops_bound [OF memop_step store_sops_le [OF i_bound ts_i]]
    show "i(fst ` store_sops is'). i < t".
  next
    from sbh_step_preserves_write_sops_bound [OF memop_step store_sops_le [OF i_bound ts_i] 
      write_sops_le [OF i_bound ts_i]]
    show "i(fst ` write_sops sb'). i < t".
  next
    from sbh_step_preserves_tmps_bound' [OF memop_step] tmps_le [OF i_bound ts_i]
    show "dom θ'  load_tmps is' = {i. i < t}"
      by auto
  next
    from valid_sops_stmt [OF i_bound ts_i]
    show "valid_sops_stmt t s".
  next
    from valid_sops_stmt_sb [OF i_bound ts_i] sbh_step_prog_configs_eq [OF memop_step]
    show "(s', t')prog_configs sb'. valid_sops_stmt t' s'"
      by auto
  qed
  then show ?thesis
    by (simp add: p)
qed

definition 
  "valid_pimp ts  separated_tmps ts"

lemma prog_step_preserves_valid:
  assumes i_bound: "i < length ts"  
  assumes ts_i: "ts!i = (p,is,θ,sb::stmt_config store_buffer,𝒟,𝒪,)" 
  assumes prog_step: "θ p s (p', is')"
  assumes valid: "valid_pimp ts"
  shows "valid_pimp (ts [i:=(p',is@is',θ,sb@[Progsb p p' is'],𝒟,𝒪,)])"
using prog_step_preserves_separated_tmps [OF i_bound ts_i prog_step] valid
by (auto simp add: valid_pimp_def)

lemma flush_step_preserves_valid:
  assumes i_bound: "i < length ts"  
  assumes ts_i: "ts!i = (p,is,θ,sb::stmt_config store_buffer,𝒟,𝒪,)" 
  assumes flush_step: "(m,sb,𝒪,,𝒮) f (m', sb',𝒪',ℛ',𝒮')"
  assumes valid: "valid_pimp ts"
  shows "valid_pimp (ts [i:=(p,is,θ,sb',𝒟,𝒪',ℛ')])"
using flush_step_preserves_separated_tmps [OF i_bound ts_i flush_step] valid
by (auto simp add: valid_pimp_def)

lemma sbh_step_preserves_valid:
  assumes i_bound: "i < length ts" 
  assumes ts_i: "ts!i = (p,is,θ,sb::stmt_config store_buffer,𝒟,𝒪,)" 
  assumes memop_step: "(is, θ, sb, m,𝒟, 𝒪, ,𝒮) sbh 
                        (is', θ', sb', m',𝒟', 𝒪', ℛ', 𝒮')" 
  assumes valid: "valid_pimp ts"
  shows "valid_pimp (ts [i:=(p,is',θ',sb',𝒟',𝒪',ℛ')])"
using 
sbh_step_preserves_separated_tmps [OF i_bound ts_i memop_step] valid
by (auto simp add: valid_pimp_def)

lemma hd_prog_prog_configs: "hd_prog p sb = p  hd_prog p sb  prog_configs sb"
  by (induct sb) (auto split:memref.splits)


interpretation PIMP: xvalid_program_progress stmt_step "λ(s,t). valid_sops_stmt t s" valid_pimp
proof
  fix θ p p' is'
  assume step: "θ p s (p', is')" 
  obtain s t where p: "p = (s,t)"
    by (cases p)
  obtain s' t' where p': "p' = (s',t')"
    by (cases p')
  from prog_step_progress [OF step [simplified p p']]
  show "p'  p  is'  []"
    by (simp add: p p')
next
  fix θ p p' is'
  assume step: "θ p s (p', is')" 
    and valid_stmt: "(λ(s, t). valid_sops_stmt t s) p"
  obtain s t where p: "p = (s,t)"
    by (cases p)
  obtain s' t' where p': "p' = (s',t')"
    by (cases p')
  from valid_sops_stmt_invariant [OF step [simplified p p'] valid_stmt [simplified p, simplified]]
  have "valid_sops_stmt t' s'".
  then show "(λ(s, t). valid_sops_stmt t s) p'" by (simp add: p')
next
  fix i ts p "is" 𝒪  𝒟 θ sb
  assume i_bound: "i < length ts" 
    and ts_i: "ts ! i = (p, is, θ, sb::(stmt × nat) memref list, 𝒟, 𝒪,)" 
    and valid: "valid_pimp ts"
  from valid have "separated_tmps ts"
    by (simp add: valid_pimp_def)
  then interpret separated_tmps ts .
  obtain s t where p: "p = (s,t)"
    by (cases p)
  from valid_sops_stmt [OF i_bound ts_i [simplified p]]
  show "(λ(s, t). valid_sops_stmt t s) p"
    by (auto simp add: p)
next
  fix i ts p "is" 𝒪  𝒟  θ sb
  assume i_bound: "i < length ts" 
    and ts_i: "ts ! i = (p, is, θ, sb::(stmt × nat) memref list, 𝒟, 𝒪,)" 
    and valid: "valid_pimp ts"
  from valid have "separated_tmps ts"
    by (simp add: valid_pimp_def)
  then interpret separated_tmps ts .
  obtain s t where p: "p = (s,t)"
    by (cases p)
  from hd_prog_prog_configs [of p sb] valid_sops_stmt [OF i_bound ts_i [simplified p]]
  valid_sops_stmt_sb [OF i_bound ts_i [simplified p]]
  show "(λ(s, t). valid_sops_stmt t s) (hd_prog p sb)"
    by (auto simp add: p)
next
  fix i ts p "is" 𝒪  𝒟 θ sb p' is'
  assume i_bound: "i < length ts" 
    and ts_i: "ts ! i = (p, is, θ, sb, 𝒟, 𝒪,)" 
    and step: "θ p s (p', is')"
    and valid: "valid_pimp ts"
  show "distinct_load_tmps is' 
          load_tmps is'  load_tmps is = {} 
          load_tmps is'  read_tmps sb = {}"
  proof -
    obtain s t where p: "p=(s,t)" by (cases p)
    obtain s' t' where p': "p'=(s',t')" by (cases p')
    note ts_i = ts_i [simplified p]
    note step = step [simplified p p']
    from valid 
    interpret separated_tmps ts
      by (simp add: valid_pimp_def)
     

    from sbh_step_distinct_load_tmps_prog_step [OF step load_tmps_le [OF i_bound ts_i]
      read_tmps_le [OF i_bound ts_i]]
    show ?thesis .
  qed
next
  fix i ts p "is" 𝒪  𝒟 θ sb p' is'
  assume i_bound: "i < length ts" 
    and ts_i: "ts ! i = (p, is, θ, sb, 𝒟, 𝒪,)" 
    and step: "θ p s (p', is')"
    and valid: "valid_pimp ts"
  show "data_dependency_consistent_instrs (dom θ  load_tmps is) is' 
          load_tmps is'  (fst ` store_sops is) = {} 
          load_tmps is'  (fst ` write_sops sb) = {}"
  proof -
    obtain s t where p: "p=(s,t)" by (cases p)
    obtain s' t' where p': "p'=(s',t')" by (cases p')
    note ts_i = ts_i [simplified p]
    note step = step [simplified p p']
    from valid 
    interpret separated_tmps ts
      by (simp add: valid_pimp_def)

    from sbh_valid_data_dependency_prog_step [OF step store_sops_le [OF i_bound ts_i]
      write_sops_le [OF i_bound ts_i] valid_sops_stmt [OF i_bound ts_i]] tmps_le [OF i_bound ts_i]
    show ?thesis by auto
  qed
next
  fix i ts p "is" 𝒪  𝒟 θ sb p' is'
  assume i_bound: "i < length ts" 
    and ts_i: "ts ! i = (p, is, θ, sb, 𝒟, 𝒪,)" 
    and step: "θ p s (p', is')"
    and valid: "valid_pimp ts"
  show "load_tmps is'  dom θ = {}"
  proof -
    obtain s t where p: "p=(s,t)" by (cases p)
    obtain s' t' where p': "p'=(s',t')" by (cases p')
    note ts_i = ts_i [simplified p]
    note step = step [simplified p p']
    from valid 
    interpret separated_tmps ts
      by (simp add: valid_pimp_def)  
    from sbh_load_tmps_fresh_prog_step [OF step tmps_le' [OF i_bound ts_i]]
    show ?thesis .
  qed
next
  fix θ p p' "is"
  assume  step: "θ p s (p', is)"
    and valid: "(λ(s, t). valid_sops_stmt t s) p"
  show  "sopstore_sops is. valid_sop sop"
  proof -
    obtain s t where p: "p=(s,t)" by (cases p)
    obtain s' t' where p': "p'=(s',t')" by (cases p')
    note step = step [simplified p p']
    from sbh_valid_sops_prog_step [OF step valid [simplified p,simplified]]
    show ?thesis .
  qed
next
  fix i ts p "is" 𝒪  𝒟 θ sb p' is'
  assume i_bound: "i < length ts" 
    and ts_i: "ts ! i = (p, is, θ, sb::stmt_config store_buffer, 𝒟, 𝒪,)" 
    and step: "θ p s (p', is')"
    and valid: "valid_pimp ts"
  from prog_step_preserves_valid [OF i_bound ts_i step valid]
  show "valid_pimp (ts[i := (p', is @ is', θ, sb @ [Progsb p p' is'], 𝒟, 𝒪,)])" .
next
  fix i ts p "is" 𝒪  𝒟 θ sb  𝒮 m m' sb' 𝒪' ℛ' 𝒮'
  assume i_bound: "i < length ts" 
    and ts_i: "ts ! i = (p, is, θ, sb::stmt_config store_buffer, 𝒟, 𝒪,)" 
    and step: "(m, sb, 𝒪, ,𝒮) f (m', sb',𝒪',ℛ',𝒮')"
    and valid: "valid_pimp ts"
  thm flush_step_preserves_valid [OF ]
  from flush_step_preserves_valid [OF i_bound ts_i step valid]
  show "valid_pimp (ts[i := (p, is, θ, sb', 𝒟, 𝒪',ℛ')])" .
next
  fix i ts p "is" 𝒪  𝒟 θ sb 𝒮 m is' 𝒪' ℛ' 𝒟' θ' sb' 𝒮' m'
  assume i_bound: "i < length ts" 
    and ts_i: "ts ! i = (p, is, θ, sb::stmt_config store_buffer, 𝒟, 𝒪,)"
    and step: "(is, θ, sb, m, 𝒟, 𝒪, , 𝒮) sbh 
                  (is', θ', sb', m',𝒟', 𝒪', ℛ',𝒮')"
    and valid: "valid_pimp ts"
  from sbh_step_preserves_valid [OF i_bound ts_i step valid]
  show "valid_pimp (ts[i := (p, is', θ', sb', 𝒟', 𝒪',ℛ')])" .
qed

thm PIMP.concurrent_direct_steps_simulates_store_buffer_history_step
thm PIMP.concurrent_direct_steps_simulates_store_buffer_history_steps
thm PIMP.concurrent_direct_steps_simulates_store_buffer_step

text ‹We can instantiate PIMP with the various memory models.›

(* FIXME: note I used () instead of sb , because simplifier rewrites sb::unit to sb.
  Make this consistent with interpretations/theorems in ReduceStoreBuffer *)
interpretation direct: 
  computation direct_memop_step empty_storebuffer_step stmt_step "λp p' is sb. ()".
interpretation virtual: 
  computation virtual_memop_step empty_storebuffer_step stmt_step "λp p' is sb. ()".
interpretation store_buffer:
  computation sb_memop_step store_buffer_step stmt_step "λp p' is sb. sb" .
interpretation store_buffer_history:
  computation sbh_memop_step flush_step stmt_step "λp p' is sb. sb @ [Progsb p p' is]".

abbreviation direct_pimp_step:: 
  "(stmt_config,unit,bool,owns,rels,shared) global_config  (stmt_config,unit,bool,owns,rels,shared) global_config  bool" 
  ("_ dp _" [60,60] 100)
where
"c dp d  direct.concurrent_step c d"

abbreviation direct_pimp_steps:: 
  "(stmt_config,unit,bool,owns,rels,shared) global_config  (stmt_config,unit,bool,owns,rels,shared) global_config  bool" 
  ("_ dp* _" [60,60] 100)
where
"direct_pimp_steps == direct_pimp_step^**"

text ‹Execution examples›



lemma Assign_Const_ex: 
"([((Assign True (Tmp ({},λθ. a)) (Const c) (λθ. A) (λθ. L) (λθ. R) (λθ. W),t),[],θ,(),𝒟,𝒪,)],m,𝒮) dp* 
 ([((Skip,t),[],θ,(),True,𝒪  A - R,Map.empty)],m(a := c),𝒮W RA L)"
apply (rule converse_rtranclp_into_rtranclp)
apply  (rule direct.Program [where i=0])
apply    simp
apply   simp
apply  (rule Assign)
apply simp
apply (rule converse_rtranclp_into_rtranclp)
apply  (rule direct.Memop [where i=0])
apply    simp
apply   simp
apply  (rule direct_memop_step.WriteVolatile)
apply simp
done

lemma 
" ([((Assign True (Tmp ({},λθ. a)) (Binop (+) (Mem True x) (Mem True y)) (λθ. A) (λθ. L) (λθ. R) (λθ. W),t),[],θ,(),𝒟,𝒪,)],m,S) 
 dp* 
 ([((Skip,t + 2),[],θ(tm x, t + 1 m y),(),True,𝒪  A - R,Map.empty)],m(a := m x + m y),SW RA L)"
apply (rule converse_rtranclp_into_rtranclp)
apply  (rule direct.Program [where i=0])
apply    simp
apply   simp
apply  (rule Assign)
apply simp

apply (rule converse_rtranclp_into_rtranclp)
apply  (rule direct.Memop)
apply    simp
apply   simp
apply  (rule direct_memop_step.Read )
apply simp

apply (rule converse_rtranclp_into_rtranclp)
apply  (rule direct.Memop)
apply    simp
apply   simp
apply  (rule direct_memop_step.Read)
apply simp

apply (rule converse_rtranclp_into_rtranclp)
apply  (rule direct.Memop)
apply    simp
apply   simp
apply  (rule direct_memop_step.WriteVolatile )
apply simp
done


lemma  
assumes isTrue: "isTrue c"
shows  
"([((Cond (Const c) (Assign True (Tmp ({},λθ. a)) (Const c) (λθ. A) (λθ. L) (λθ. R) (λθ. W)) Skip,t) ,[],θ,(),𝒟,𝒪,)],m,𝒮) dp* 
 ([((Skip,t),[],θ,(),True,𝒪  A - R,Map.empty)],m(a := c),𝒮W RA L)"
apply (rule converse_rtranclp_into_rtranclp)
apply  (rule direct.Program [where i=0])
apply    simp
apply   simp
apply  (rule Cond)
apply  simp
apply simp

apply (rule converse_rtranclp_into_rtranclp)
apply  (rule direct.Program [where i=0])
apply    simp
apply   simp
apply  (rule CondTrue)
apply   simp
apply  (simp add: isTrue)
apply simp

apply (rule Assign_Const_ex)
done


end

Theory SyntaxTweaks

theory SyntaxTweaks 
imports Main
begin

syntax (implnl output)
  "⟹" :: "prop  prop  prop" ("_ // _" [0,1] 1)

notation (holimplnl output)
"implies" ("(2_ // _)" [0,1] 1)
notation (holimplnl output)
"conj" ("_ / _" [34,35]35)
  

syntax (letnl output)
  "_binds"      :: "[letbind, letbinds] => letbinds"     ("_;//_")
text ‹Theorems as inference rules, usepackage mathpartir›

syntax (eqindent output) "op =" ::"['a, 'a] => bool"               ( "(2_ =/ _)" [49,50]50)

(* LOGIC *)
syntax (latex output)
  If            :: "[bool, 'a, 'a] => 'a"
  ("(latex‹\\holkeyword{›iflatex‹}›(_)/ latex‹\\holkeyword{›thenlatex‹}› (_)/ latex‹\\holkeyword{›elselatex‹}› (_))" 10)

  "_Let"        :: "[letbinds, 'a] => 'a"
  ("(latex‹\\holkeyword{›letlatex‹}› (_)/ latex‹\\holkeyword{›inlatex‹}› (_))" 10)

  "_case_syntax":: "['a, cases_syn] => 'b"
  ("(latex‹\\holkeyword{›caselatex‹}› _ latex‹\\holkeyword{›oflatex‹}›/ _)" 10)

notation (Rule output)
  Pure.imp  ("latex‹\\mbox{}\\inferrule{\\mbox{›_latex‹}}›latex‹{\\mbox{›_latex‹}}›")

syntax (Rule output)
  "_bigimpl" :: "asms  prop  prop"
  ("latex‹\\mbox{}\\inferrule{›_latex‹}›latex‹{\\mbox{›_latex‹}}›")

  "_asms" :: "prop  asms  asms" 
  ("latex‹\\mbox{›_latex‹}\\\\›/ _")

  "_asm" :: "prop  asms" ("latex‹\\mbox{›_latex‹}›")


notation (Axiom output)
  "Trueprop"  ("latex‹\\mbox{}\\inferrule{\\mbox{}}{\\mbox{›_latex‹}}›")

syntax (IfThen output)
  "==>" :: "prop  prop  prop"
  ("latex‹{\\normalsize{}›Iflatex‹\\,}› _/ latex‹{\\normalsize \\,›thenlatex‹\\,}›/ _.")

  "_bigimpl" :: "asms  prop  prop"
  ("latex‹{\\normalsize{}›Iflatex‹\\,}› _ /latex‹{\\normalsize \\,›thenlatex‹\\,}›/ _.")

  "_asms" :: "prop  asms  asms" ("latex‹\\mbox{›_latex‹}› /latex‹{\\normalsize \\,›andlatex‹\\,}›/ _")
  "_asm" :: "prop  asms" ("latex‹\\mbox{›_latex‹}›")

syntax (IfThenNoBox output)
  "==>" :: "prop  prop  prop"
  ("latex‹{\\normalsize{}›Iflatex‹\\,}› _/ latex‹{\\normalsize \\,›thenlatex‹\\,}›/ _.")
  "_bigimpl" :: "asms  prop  prop"
  ("latex‹{\\normalsize{}›Iflatex‹\\,}› _ /latex‹{\\normalsize \\,›thenlatex‹:\\,}›/ _.")
  "_asms" :: "prop  asms  asms" ("_ /latex‹{\\normalsize \\,›andlatex‹\\,}›/ _")
  "_asm" :: "prop  asms" ("_")


text ‹power›
syntax (latex output)
  power :: "['a::power, nat] => 'a"           ("__" [1000,0]80)

(* empty set *)
syntax (latex output)
  "_emptyset" :: "'a set"              ("")
translations
  "_emptyset"      <= "{}"

text ‹insert›
translations 
(*
  "{x} ∪ A" <= "insert x A"
*)
  "{x,y}" <= "{x}  {y}"
  "{x,y}  A" <= "{x}  ({y}  A)"
  "{x}" <= "{x}  {}"


syntax (latex output)
 Cons :: "'a  'a list  'a list"    (infixr "" 65)

syntax (latex output)
 "Some" :: "'a  'a option" ("(_)")
 "None" :: "'a option" ("")

text ‹lesser indentation as default›
syntax (latex output)
  "ALL "        :: "[idts, bool] => bool"                ("(2_./ _)" [0, 10] 10)
  "EX "         :: "[idts, bool] => bool"                ("(2_./ _)" [0, 10] 10)

text ‹space around ∈›
syntax (latex output)
  "_Ball"       :: "pttrn => 'a set => bool => bool"      ("(3_latex‹\\,›∈_./ _)" [0, 0, 10] 10)
  "_Bex"        :: "pttrn => 'a set => bool => bool"      ("(3_latex‹\\,›∈_./ _)" [0, 0, 10] 10)

text ‹compact line breaking for some infix operators›
term "HOL.conj"
notation (compact output)
"conj" ("_ / _" [34,35]35)
notation (compact output)
"append" ("_ @/ _" [64,65]65)

text ‹force a newline after definition equation›
syntax (defnl output)
  "=="       :: "[prop, prop] => prop"                ("(2_ // _)" [1,2] 2) 
syntax (defeqnl output)
  "=="       :: "[prop, prop] => prop"                ("(2_ =// _)" [1,2] 2) 
syntax (eqnl output)
  "op ="       :: "['a, 'a] => bool"                     ("(2_ =// _)" [1,2] 2) 
syntax (latex output)
  "=="       :: "[prop, prop] => prop"                ("(2_ / _)" [1,2] 2) 

text ‹New-line after assumptions›
syntax (asmnl output)
  "_asms" :: "prop  asms  asms" 
  ("_; // _")

text ‹uncurry functions›
syntax (uncurry output)
"_cargs" :: "'a  cargs  cargs" ("_, _")
"_applC" :: "[('b => 'a), cargs] => logic" ("(1_/(1'(_')))" [1000, 0] 1000)

text ‹but keep curried notation for constructors›
syntax (uncurry output)
"_cargs_curry":: "'a  cargs  cargs" ("_ _" [1000,1000] 1000)
"_applC_curry":: "[('b => 'a), cargs] => logic" ("(1_/ _)" [1000, 1000] 999)



text ‹`dot'-selector notation for records›
syntax (latex output)
"_rec_sel" :: "'r  id  'a" ("_._" [1000,1000]1000)


ML structure Latex =   (* FIXME eliminate clone of Latex.latex_markup (export it in Pure) *)
struct
  open Latex;

  fun latex_markup (s, props: Properties.T) =
    if s = Markup.commandN orelse s = Markup.keyword1N orelse s = Markup.keyword3N
    then ("\\isacommand{", "}")
    else if s = Markup.keyword2N
    then ("\\isakeyword{", "}")
    else Markup.no_output;
end;

fun latex_markup (s, props) =
  if s = Markup.boundN orelse s = Markup.freeN orelse s = Markup.varN orelse s = Markup.tfreeN orelse s = Markup.tvarN
  then ("\\" ^ s ^ "ify{", "}")
  else Latex.latex_markup (s, props);


val _ = Markup.add_mode Latex.latexN latex_markup;


text ‹invisible binder in case we want to force "bound"-markup›
consts Bind:: "('a  'b)  'c" (binder "Bind " 10)
translations
  "f" <= "Bind x. f"


(* length *)
notation (latex output)
  length  ("|_|")

(* Optional values *)
notation (latex output)
  None ("")

notation (latex output)
  Some ("_")

(* nth *)
notation (latex output)
  nth  ("_latex‹\\ensuremath{_{[›_latex‹]}}›" [1000,0] 1000)

end

Theory Abbrevs

theory Abbrevs
imports PIMP SyntaxTweaks
begin


text ‹now we can use dots as a term›

consts dots::"'a" ("") 


lemma conj_to_impl: "(P  Q  R) = (P  Q  R)"
  by auto


notation (in xvalid_program) (latex output)
barrier_inv ("flush'_inv")


abbreviation
"acquire sb owns  acquired True sb owns"
notation (latex output)
direct_memop_step ("_ latex‹$\\overset{\\isa{v}_\\isa{d}}{\\rightarrow}_{\\isa{m}}$› _" [60,60] 100)
notation (latex output)
virtual_memop_step ("_ latex‹$\\overset{\\isa{v}}{\\rightarrow}_{\\isa{m}}$› _" [60,60] 100)



context program
begin
term "(ts, m) sb (ts',m')"
notation (latex output) store_buffer.concurrent_step ("_ latex‹$\\overset{\\isa{sb}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output) virtual.concurrent_step ("_ latex‹$\\overset{\\isa{v}}{\\Rightarrow}$› _" [60,60] 100)
thm store_buffer.concurrent_step.Program
end


abbreviation (output)
"sbh_global_step  computation.concurrent_step sbh_memop_step flush_step stmt_step (λp p' is sb. sb @ [Progsb p p' is])"

notation (latex output)
sbh_global_step ("_ latex‹$\\overset{\\isa{sbh}}{\\Rightarrow}$› _" [60,60] 100)


notation (latex output)
direct_pimp_step ("_ latex‹$\\overset{\\isa{v}}{\\Rightarrow}$› _" [60,60] 100)


notation (latex output)
sbh_memop_step ("_ latex‹$\\overset{\\isa{sbh}}{\\rightarrow}_{\\isa{m}}$› _" [60,60] 100)

notation (latex output)
sb_memop_step ("_ latex‹$\\overset{\\isa{sb}}{\\rightarrow}_{\\isa{m}}$› _" [60,60] 100)


notation (output) 
sim_direct_config ("_  _ " [60,60] 100)

notation (output) 
flush_step ("_ sbh _" [60,60] 100)

notation (output) 
store_buffer_step ("_ sb _" [60,60] 100)

notation (output)
outstanding_refs ("refs")

notation (output)
is_volatile_Writesb ("volatile'_Write")

abbreviation (output)
"not_volatile_write  Not  is_volatile_Writesb"

notation (output)
"flush_all_until_volatile_write" ("exec'_all'_until'_volatile'_write")
notation (output)
"share_all_until_volatile_write" ("share'_all'_until'_volatile'_write")

notation (output)
stmt_step ("_ _ p _" [60,60,60] 100)

notation (output)
augment_rels ("aug")

context program
begin
notation (latex output)
direct_concurrent_step ("_ latex‹$\\overset{\\isa{v}_\\isa{d}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output)
direct_concurrent_steps ("_ latex‹$\\overset{\\isa{v}_\\isa{d}}{\\Rightarrow}^{*}$› _" [60,60] 100)

notation (latex output)
sbh_concurrent_step ("_ latex‹$\\overset{\\isa{sbh}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output) 
sbh_concurrent_steps ("_ latex‹$\\overset{\\isa{sbh}}{\\Rightarrow}^{*}$› _" [60,60] 100)

notation (latex output)
sb_concurrent_step ("_ latex‹$\\overset{\\isa{sb}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output) 
sb_concurrent_steps ("_ latex‹$\\overset{\\isa{sb}}{\\Rightarrow}^{*}$› _" [60,60] 100)

notation (latex output)
virtual_concurrent_step ("_ latex‹$\\overset{\\isa{v}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output) 
virtual_concurrent_steps ("_ latex‹$\\overset{\\isa{v}}{\\Rightarrow}^{*}$› _" [60,60] 100)
end


context xvalid_program_progress
begin

abbreviation
"safe_reach_virtual_free_flowing  safe_reach virtual_concurrent_step safe_free_flowing"
notation (latex output)
"safe_reach_virtual_free_flowing" ("safe'_reach")

abbreviation
"safe_reach_direct_delayed  safe_reach direct_concurrent_step safe_delayed"

notation (latex output)
"safe_reach_direct_delayed" ("safe'_reach'_delayed")

end



(* hide unit's in tuples *)

translations
 "x" <= "(x,())"
 "x" <= "((),x)"


translations
"CONST initialv xs ys" <= "CONST initialv xs ys zs"


end

Theory Variants

(*<*)
theory Variants
imports Abbrevs 
begin


lemma restrict_map_inverse: "m |` (dom m - X) = m |`(-X)"
  apply (rule ext)
  apply (auto simp add: restrict_map_def)
  done

lemma conj_assoc: "((P  Q)  X) = (P  Q  X)"
  by simp

(* Constructor markup for some datatypes *)
(* instr *)
notation (latex output)
Read ("latex‹\\constructor{Read}›")
notation (latex output)
Write ("latex‹\\constructor{Write}›")
notation (latex output)
RMW ("latex‹\\constructor{RMW}›")
notation (latex output)
Fence ("latex‹\\constructor{Fence}›")
notation (latex output)
Ghost ("latex‹\\constructor{Ghost}›")

(* memref *)
notation (latex output)
Writesb ("latex‹\\constructor{Write}›sb")
notation (latex output)
Readsb ("latex‹\\constructor{Read}›sb")
notation (latex output)
Progsb ("latex‹\\constructor{Prog}›sb")
notation (latex output)
Ghostsb ("latex‹\\constructor{Ghost}›sb")



(* expr *)
notation (latex output)
Const ("latex‹\\constructor{Const}›")
notation (latex output)
Mem ("latex‹\\constructor{Mem}›")
notation (latex output)
Tmp ("latex‹\\constructor{Tmp}›")
notation (latex output)
Unop ("latex‹\\constructor{Unop}›")
notation (latex output)
Binop ("latex‹\\constructor{Binop}›")

(* stmt *)
notation (latex output)
Skip ("latex‹\\constructor{Skip}›")
notation (latex output)
Assign ("latex‹\\constructor{Assign}›")
notation (latex output)
CAS ("latex‹\\constructor{CAS}›")
notation (latex output)
Seq ("latex‹\\constructor{Seq}›")
notation (latex output)
Cond ("latex‹\\constructor{Cond}›")
notation (latex output)
While ("latex‹\\constructor{While}›")
notation (latex output)
SGhost ("latex‹\\constructor{SGhost}›")
notation (latex output)
SFence ("latex‹\\constructor{SFence}›")

lemma sim_direct_config_def': "tssb d ts 
(tssb = (map (λ(p,is, θ,sb::unit,𝒟, 𝒪,). (p,is,θ,[],(),(),())) ts))"
apply (rule HOL.eq_reflection)
apply rule
apply  (erule sim_direct_config.cases)
apply  (clarsimp)
apply  (rule nth_equalityI)
apply   simp
apply  clarsimp
apply  (case_tac "ts!i")
apply  fastforce
apply (rule sim_direct_config.intros)
apply auto
done

ML @{term "(λ(p,is, θ,sb::unit,𝒟, 𝒪,). (p,is,θ,[],(),(),()))"}

lemma DRead: "(Read volatile a t # is,θ, x, m,ghst) 
               (is, θ (tm a), x, m, ghst)"
apply (cases ghst) 
apply (simp add: direct_memop_step.Read)
done

lemma DWriteNonVolatile:"
  (Write False a (D,f) A L R W#is, θ, x, m, ghst)  (is, θ, x, m(a := f θ), ghst)"
apply (cases ghst) 
apply (simp add: direct_memop_step.WriteNonVolatile)
done

lemma DWriteVolatile:
  "ghst = (𝒟, 𝒪, , 𝒮)  ghst' = (True, 𝒪  A - R, Map.empty, 𝒮W RA L) 
    (Write True a (D,f) A L R W# is, θ, x, m, ghst)  (is, θ,  x, m(a:=f θ), ghst')"
by (simp add: direct_memop_step.WriteVolatile)

lemma DGhost:
  "ghst = (𝒟, 𝒪, , 𝒮)  ghst' = (𝒟, 𝒪  A - R, augment_rels (dom 𝒮) R , 𝒮W RA L) 
    (Ghost A L R W# is, θ, x, m, ghst)  (is, θ,  x, m, ghst')"
by (simp add: direct_memop_step.Ghost)

lemma DRMWReadOnly:
  "¬ cond (θ(tm a)); ghst = (𝒟, 𝒪, , 𝒮); ghst'=(False, 𝒪, Map.empty,𝒮)  
   (RMW a t (D,f) cond ret A L R W # is, θ, x, m, ghst)  (is, θ(tm a),x,m, ghst')"
apply (simp add: direct_memop_step.RMWReadOnly)
done

lemma DRMWWrite:
  "cond (θ(tm a)); 
    θ' = θ(tret (m a) (f(θ(tm a))));
    m' = m(a:= f(θ(tm a)));
    ghst = (𝒟, 𝒪, , 𝒮); 
   ghst' = (False,𝒪  A - R, Map.empty, 𝒮W RA L) 
    
   (RMW a t (D,f) cond ret A L R W# is, θ, x, m, ghst)  (is, θ',x, m' , ghst')"
apply (simp add: direct_memop_step.RMWWrite)
done

lemma VRead: "(Read volatile a t # is,θ, x, m,ghst) v
               (is, θ (tm a), x, m, ghst)"
apply (cases ghst) 
apply (simp add: virtual_memop_step.Read)
done

lemma VWriteNonVolatile:"
  (Write False a (D,f) A L R W#is, θ, x, m, ghst) v (is, θ, x, m(a := f θ), ghst)"
apply (cases ghst) 
apply (simp add: virtual_memop_step.WriteNonVolatile)
done

lemma VWriteVolatile:
  "ghst = (𝒟, 𝒪, , 𝒮)  ghst' = (True, 𝒪  A - R, , 𝒮W RA L) 
    (Write True a (D,f) A L R W# is, θ, x, m, ghst) v (is, θ,  x, m(a:=f θ), ghst')"
by (simp add: virtual_memop_step.WriteVolatile)

lemma VRMWReadOnly:
  "¬ cond (θ(tm a)); ghst = (𝒟, 𝒪, , 𝒮); ghst'=(False, 𝒪,,𝒮)  
   (RMW a t (D,f) cond ret A L R W # is, θ, x, m, ghst) v (is, θ(tm a),x,m, ghst')"
apply (simp add: virtual_memop_step.RMWReadOnly)
done

lemma VFence:
  "ghst = (𝒟, 𝒪, , 𝒮)  ghst' = (False, 𝒪, , 𝒮) 
    (Fence# is, θ, x, m, ghst) v (is, θ,  x, m, ghst')"
by (simp add: virtual_memop_step.Fence)

lemma VGhost:
  "ghst = (𝒟, 𝒪, , 𝒮)  ghst' = (𝒟, 𝒪  A - R, , 𝒮W RA L)  
    (Ghost A L R W# is, θ, x, m, ghst) v (is, θ,  x, m, ghst')"
by (simp add: virtual_memop_step.Ghost)

lemma VRMWWrite:
  "cond (θ(tm a)); 
    θ' = θ(tret (m a) (f(θ(tm a))));
    m' = m(a:= f(θ(tm a)));
    ghst = (𝒟, 𝒪, , 𝒮); 
   ghst' = (False,𝒪  A - R, , 𝒮W RA L) 
    
   (RMW a t (D,f) cond ret A L R W# is, θ, x, m, ghst) v (is, θ',x, m' , ghst')"
apply (simp add: virtual_memop_step.RMWWrite)
done


lemma SafeWriteVolatile:
  "j < length 𝒪s. ij  a  𝒪s!j; a  read_only 𝒮;    
    j < length 𝒪s. ij   A   𝒪s!j = {};
    A  𝒪  dom 𝒮; L  A; R  𝒪; A  R = {}
   
    
   𝒪s,i(Write True a (D,f) A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"
apply (rule safe_direct_memop_state.WriteVolatile)
apply auto
done

lemma SafeDelayedWriteVolatile:
  "j < length 𝒪s. ij  a  (𝒪s!j  dom (ℛs!j)); a  read_only 𝒮;
  j < length 𝒪s. ij   A   (𝒪s!j  dom (ℛs!j)) = {};
    A  dom 𝒮  𝒪; L  A; R  𝒪; A  R = {}
   
    
   𝒪s,ℛs,i(Write True a (D,f) A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"
apply (rule safe_delayed_direct_memop_state.WriteVolatile)
apply auto
done


lemma SafeRMWReadOnly:
  "¬ cond (θ(tm a)); a  dom 𝒮  𝒪  
   𝒪s,i (RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"
apply (rule safe_direct_memop_state.RMWReadOnly)
apply auto
done

lemma SafeDelayedRMWReadOnly:
  "¬ cond (θ(tm a)); a  dom 𝒮  𝒪; 
   j < length 𝒪s. ij  (ℛs!j) a  Some False ― ‹no release of unshared address›
    
   𝒪s,ℛs,i(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"
apply (rule safe_delayed_direct_memop_state.RMWReadOnly)
apply auto
done

lemma SafeRMWWrite:
  "cond (θ(tm a));  
    j < length 𝒪s. ij  a  𝒪s!j; a  read_only 𝒮;
    j < length 𝒪s. ij  A  𝒪s!j  = {};    
    A   𝒪  dom 𝒮; L  A; R  𝒪; A  R = {}
     
    
   𝒪s,i (RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"
apply (rule safe_direct_memop_state.RMWWrite)
apply auto
done

lemma SafeDelayedRMWWrite:
  "cond (θ(tm a)); a  dom 𝒮  𝒪;  
    j < length 𝒪s. ij  a  (𝒪s!j  dom (ℛs!j));a  read_only 𝒮;
    j < length 𝒪s. ij  A  (𝒪s!j  dom (ℛs!j))  = {};
    A  dom 𝒮  𝒪; L  A; R  𝒪; A  R = {}
     
    
   𝒪s,ℛs,i(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)"
apply (rule safe_delayed_direct_memop_state.RMWWrite)
apply auto
done

lemma  WritesbNonVolatile: 
  "(m, Writesb False a sop v A L R W# rs,𝒪,,𝒮) f (m(a := v), rs,𝒪,,𝒮)"
  apply (rule flush_step.Writesb)
  apply auto
  done

lemma WritesbVolatile: 
"𝒪'= 𝒪  A - R;  𝒮'=(𝒮W RA L) 
  (m, Writesb True a sop v A L R W# rs,𝒪,,𝒮) f (m(a := v), rs,𝒪',Map.empty,𝒮')"
  apply (rule flush_step.Writesb)
  apply auto
  done

lemma Ghostsb: "𝒪'= 𝒪  A - R; ℛ'= augment_rels (dom 𝒮) R ; 𝒮'=𝒮W RA L  
             (m, Ghostsb A L R W# rs,𝒪,,𝒮) f (m, rs,𝒪',ℛ',𝒮')"
by (simp add: flush_step.Ghost)

lemma  SBHRead: 
  "v = (case (buffered_val sb a) of Some v'  v' | None  m a);
   sb' = sb@[Readsb volatile a t v] 
   
   (Read volatile a t # is, θ, sb, m,ghst) sbh
          (is, θ (tv), sb', m,ghst)"
  apply (cases ghst)
  apply (cases "buffered_val sb a")
  apply (auto simp add: SBHReadBuffered SBHReadUnbuffered)
  done

lemma  SBRead: 
  "v = (case (buffered_val sb a) of Some v'  v' | None  m a)
   
   (Read volatile a t # is, θ, sb, m,ghst) sb
          (is, θ (tv), sb, m,ghst)"
  apply (cases ghst)
  apply (cases "buffered_val sb a")
  apply (auto simp add: SBReadBuffered SBReadUnbuffered)
  done

lemma  SBHReadBuffered': 
  "buffered_val sb a = Some v;
   sb' = sb@[Readsb volatile a t v] 
   
   (Read volatile a t # is, θ, sb, m, 𝒟, 𝒪,, 𝒮) sbh
          (is, θ (tv), sb', m, 𝒟, 𝒪,, 𝒮)"
  by (simp add: SBHReadBuffered)

lemma SBHReadUnbuffered': 
  "buffered_val sb a = None;
    sb' = sb@[Readsb volatile a t (m a)] 
   
   (Read volatile a t # is,θ, sb, m, 𝒟, 𝒪,, 𝒮) sbh
          (is,θ (tm a), sb', m, 𝒟, 𝒪,, 𝒮)"
by (simp add: SBHReadUnbuffered)

lemma SBHWriteNonVolatile':
  " sb'= sb@ [Writesb False a (D,f) (f θ) A L R W] 
   
   (Write False a (D,f) A L R W#is,θ, sb, m, ghst) sbh
          (is, θ, sb', m, ghst)"
by (cases ghst) (simp add: SBHWriteNonVolatile)

lemma SBWriteNonVolatile':
  " sb'= sb@ [Writesb False a (D,f) (f θ) A L R W] 
   
   (Write False a (D,f) A L R W#is,θ, sb, m, ghst) sb
          (is, θ, sb', m, ghst)"
by (cases ghst) (simp add: SBWriteNonVolatile)

lemma SBHWriteVolatile':
  "sb'= sb@[Writesb True a (D,f) (f θ) A L R W]; ghst = (𝒟, 𝒪, , 𝒮); ghst' = (True, 𝒪,, 𝒮)
    
   (Write True a (D,f) A L R W# is,θ, sb, m,ghst) sbh
         (is,θ, sb', m,ghst')"
by (simp add: SBHWriteVolatile)

lemma SBHGhost':
  "(Ghost A L R W# is, θ, sb, m, G) sbh
         (is, θ, sb@[Ghostsb A L R W], m, G)"
  by (cases G) (simp add: SBHGhost)


lemma SBWriteVolatile':
  "sb'= sb@[Writesb True a (D,f) (f θ) A L R W]
    
   (Write True a (D,f) A L R W# is,θ, sb, m,ghst) sb
         (is,θ, sb', m,ghst)"
by (cases ghst) (simp add: SBWriteVolatile)

lemma SBWrite':
  "sb'= sb@[Writesb volatile a (D,f) (f θ) A L R W]
    
   (Write volatile a (D,f) A L R W# is,θ, sb, m,ghst) sb
         (is,θ, sb', m,ghst)"
apply (cases volatile)
apply (auto intro: SBWriteVolatile' SBWriteNonVolatile')
done


lemma SBHRMWReadOnly':
  "¬ cond (θ(tm a)); ghst = (𝒟, 𝒪, , 𝒮); ghst' = (False, 𝒪, Map.empty,𝒮)  
   (RMW a t (D,f) cond ret A L R W# is, θ, [], m, ghst) sbh (is, θ(tm a),[], m, ghst')"
by (simp add: SBHRMWReadOnly)

lemma SBHRMWWrite':
  "cond (θ(tm a)); θ'=θ(tret (m a) (f(θ(tm a))));m'=m(a:= f(θ(tm a)));
   ghst = (𝒟, 𝒪,, 𝒮); ghst'=(False, 𝒪  A - R, Map.empty,𝒮W RA L)  
   (RMW a t (D,f) cond ret A L R W# is, θ, [], m, ghst) sbh
         (is, θ',[], m', ghst')"
  by (simp add: SBHRMWWrite)

lemma SBRMWReadOnly':
  "¬ cond (θ(tm a)); θ'=θ(tm a)  
   (RMW a t (D,f) cond ret A L R W# is, θ, [], m, ghst) sb (is, θ',[], m, ghst)"
by (cases ghst) (simp add: SBRMWReadOnly)

lemma SBRMWWrite':
  "cond (θ(tm a)); θ'=θ(tret (m a) (f(θ(tm a))));m'=m(a:= f(θ(tm a))) 
    
   (RMW a t (D,f) cond ret A L R W# is, θ, [], m, ghst) sb
         (is, θ',[], m', ghst)"
  by (cases ghst) (simp add: SBRMWWrite)

lemma sim_config':
  "m = flush_all_until_volatile_write tssbh msbh;
    𝒮 = share_all_until_volatile_write tssbh 𝒮sbh;
    length tssbh = length ts; 
    i < length tssbh. 
           let (psbh, issbh, θsbh, sb, 𝒟sbh, 𝒪sbh,sbh) = tssbh!i;
               execs = takeWhile (Not  is_volatile_Writesb) sb;
               suspends = dropWhile (Not  is_volatile_Writesb) sb
            in  is 𝒟. instrs suspends @ issbh = is @ prog_instrs suspends 
                    𝒟sbh = (𝒟  outstanding_refs is_volatile_Writesb sb  {}) 
                ts!i = (hd_prog psbh suspends, 
                        is,
                        θsbh |` (dom θsbh - read_tmps suspends),(),
                        𝒟,  
                        acquired True execs 𝒪sbh,
                        release execs (dom 𝒮sbh) sbh)
    
     
     (tssbh,msbh,𝒮sbh)  (ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp_all add: Let_def)
done

lemma  AssignAddr':
  "sop. a  Tmp sop; a'=Tmp (eval_expr t a); t'= t + used_tmps a; is=issue_expr t a  
   θ (Assign volatile a e A L R W, t) s 
         ((Assign volatile a' e A L R W, t'),is)"
  by (simp add: AssignAddr)


lemma  Assign':
  "D  dom θ; is= issue_expr t e@[Write volatile (a θ) (eval_expr t e) (A θ) (L θ) (R θ) (W θ)]  
   θ (Assign volatile (Tmp (D,a)) e A L R W, t) s 
         ((Skip, t + used_tmps e), is)"
  by (simp add: Assign)


lemma CASAddr':
  "sop. a  Tmp sop; a'=(Tmp (eval_expr t a));t'=t + used_tmps a; is=issue_expr t a  
   θ (CAS a ce se A L R W, t) s 
         ((CAS a' ce se A L R W, t'), is)"
  by (simp add: CASAddr)

lemma CASComp':
  "sop. ce  Tmp sop;ce'=(Tmp (eval_expr t ce));t'=t + used_tmps ce; is= issue_expr t ce  
   θ (CAS (Tmp a) ce se A L R W, t) s 
         ((CAS (Tmp a) ce' se A L R W, t'), is)"
  by (cases a) (simp add: CASComp)
  
lemma CAS':
  "Da  dom θ; Dc  dom θ; eval_expr t se  = (D,f);t'=(t + used_tmps se); 
   cond = (λθ. the (θ t') = c θ);
   ret = (λv1 v2. v1);
   is = issue_expr t se@
           [RMW (a θ) t' (D,f) cond ret 
            (A θ) (L θ) (R θ) (W θ) ]  
   
   θ (CAS (Tmp (Da,a)) (Tmp (Dc,c)) se A L R W, t) s 
         ((Skip, Suc t'),is )"
  by (simp add: CAS)


lemma SCond':
  "sop. e  Tmp sop  e'= (Tmp (eval_expr t e))  t'=t + used_tmps e  is=issue_expr t e
   
   θ (Cond e s1 s2, t) s 
    ((Cond e' s1 s2, t'), is)"
  by (simp add: Cond)

lemma SWhile':
  "s'= (Cond e (Seq s (While e s)) Skip) 
   θ (While e s, t) s ((s', t),[])"
  by (simp add: stmt_step.While)


theorem (in xvalid_program) simulation_hol:
  "(tssbh,msbh,𝒮sbh) sbh (tssbh',msbh',𝒮sbh') 
   (tssbh,msbh,𝒮sbh)  (ts,m,𝒮)  safe_reach_direct safe_delayed (ts, m, 𝒮) 
   invariant tssbh 𝒮sbh msbh 
  invariant tssbh' 𝒮sbh' msbh' 
           (ts' 𝒮' m'. (ts,m,𝒮) d* (ts',m',𝒮')  (tssbh',msbh',𝒮sbh')  (ts',m',𝒮'))"
  apply clarify
  apply (drule simulation')
  by auto

theorem (in xvalid_program_progress) store_buffer_execution_result_sequential_consistent'_hol:
"(tssb,m,x) sb* (tssb',m',x') 
empty_store_buffers tssb' 
tssb d ts 
initialv ts 𝒮 valid 
safe_reach_virtual safe_free_flowing (ts,m,𝒮) 

(ts' 𝒮'. 
          (ts,m,𝒮) v* (ts',m',𝒮')  tssb' d ts')"
  apply clarify
  apply (drule store_buffer_execution_result_sequential_consistent')
  apply auto
  done

end
(*>*)

Theory Text

(*<*)
theory Text
imports Variants 
begin
(*>*)
section ‹Programming discipline \label{sec:discipline}›

text ‹
For sequential code on a single processor the store buffer is invisible, since reads respect outstanding writes in the buffer. 
This argument can be extended to thread local memory in the context of a multiprocessor architecture. 
Memory typically becomes temporarily thread local by means of locking. 
The C-idiom to identify shared portions of the memory is the \texttt{volatile} 
tag on variables and type declarations. 
Thread local memory can be accessed non-volatilely, whereas accesses to shared memory are tagged as volatile. 
This prevents the compiler from applying certain optimizations to those accesses which could cause undesired behavior, \eg to store intermediate values in registers instead of writing them to the memory.

  The basic idea behind the programming discipline is, that before gathering new information about the shared state (via reading) the thread has to make its outstanding changes to the shared state visible to others (by flushing the store buffer). 
This allows to sequentialize the reads and writes to obtain a sequentially consistent execution of the global system. 
In this sequentialization a write to shared memory happens when the write instruction exits the store buffer, and a read from the shared memory happens when all preceding writes have exited. 

We distinguish thread local and shared memory by an ownership model. 
Ownership is maintained in ghost state and can be transferred as side effect of write operations and by a dedicated ghost operation.
Every thread has a set of owned addresses. Owned addresses of different threads are disjoint. 
Moreover, there is a global set of shared addresses which can additionally be marked as read-only. 
Unowned addresses --- addresses owned by no thread --- can be accessed concurrently by all threads. They are a subset of the shared addresses. The read-only addresses are a subset of the unowned addresses (and thus of the shared addresses).
We only allow a thread to write to owned addresses and unowned, read-write addresses.
We only allow a thread to read from owned addresses and from shared addresses (even if they are owned by another thread).

All writes to shared memory have to be volatile. Reads from shared addresses also have to be volatile, except if the address is owned (\ie single writer, multiple readers) or if the address is read-only. Moreover, non-volatile writes are restricted to owned, unshared memory.
As long as a thread owns an address it is guaranteed that it is the only one writing to that address. Hence this thread can safely perform non-volatile reads to that address without missing any write. Similar it is safe for any thread to access read-only memory via non-volatile reads since there are no outstanding writes at all.


Recall that a volatile read is \Def{clean} if it is guaranteed that there is no outstanding volatile write (to any address) in the store buffer. Moreover every non-volatile read is clean.
To regain sequential consistency under the presence of store buffers every thread has to make sure that every read is clean, by flushing the store buffer when necessary. To check the flushing policy of a thread, we keep track of clean reads by means of ghost state. For every thread we maintain a dirty flag. It is reset as the store buffer gets flushed. Upon a volatile write the dirty flag is set. The dirty flag is considered to guarantee that a volatile read is clean.  



Table \ref{tab:access-grid} summarizes the access policy and Table \ref{tab:flushing} the associated flushing policy of the programming discipline.
The key motivation is to improve performance by minimizing the number of store buffer flushes, 
while staying sequentially consistent.
The need for flushing the store buffer decreases from interlocked accesses (where flushing is a side-effect) over volatile accesses to non-volatile accesses. From the viewpoint of access rights there is no difference between interlocked and volatile accesses. However, keep in mind that some interlocked operations can read from, modify and write to an address in a single atomic step of the underlying hardware and are typically used in lock-free algorithms or for the implementation of locks.



\begin{table}
\centering
\caption{Programming discipline.}
\captionsetup[table]{position=top}
\captionsetup[subtable]{position=top}
\newcommand{\mycomment}[1]{}
\subfloat[Access policy\label{tab:access-grid}]{
\begin{tabular}{m{1.2cm}@ {\hspace{2mm}}m{1.7cm}@ {\hspace{3mm}}m{1.8cm}m{2.2 cm}}
\toprule
               &     shared        &   shared   &  unshared            \\
               &     (read-write)  &   (read-only)   &                 \\
\midrule
unowned        & \mycomment{iRW, iR, iW,} vR, vW         & \mycomment{iR,} vR, R              &  unreachable\\
owned          & \mycomment{iRW, iR, iW,} vR, vW, R      & unreachable            &  \mycomment{iRW, iR, iW,} vR, vW, R, W \\
owned \mbox{by other} & \mycomment{iR,}       vR                & unreachable            &                           \\

\bottomrule
\multicolumn{4}{l}{(v)olatile, (R)ead, (W)rite}\\
\multicolumn{4}{l}{all reads have to be clean }
\end{tabular}
%\caption{Access policy \label{tab:access-grid}}
}\hspace{0.3cm}
%
%\end{table}
%
%\begin{table}
%
\subfloat[Flushing policy\label{tab:flushing}]{
\begin{tabular}{lc}
\toprule
                & flush (before)          \\     
\midrule
interlocked     & as side effect                 \\
vR            & if not clean               \\
R, vW, W           & never                  \\
\bottomrule
\end{tabular}
%\caption{Flushing policy \label{tab:flushing}}
}

\end{table}


›
section ‹Formalization \label{sec:formalization}›

text ‹

In this section we go into the details of our formalization. In our model, we distinguish the plain `memory system' from the 
`programming language semantics' which we both describe as a small-step transition relation. 
During a computation the programming language issues memory instructions (read / write) to the memory system, 
which itself returns the results in temporary registers. 
This clean interface allows us to parameterize the program semantics over the 
memory system. Our main theorem allows us to simulate a computation step in the semantics based on a 
memory system with store buffers by @{term "n"} steps in the semantics based on a   
sequentially consistent memory system. 
We refer to the former one as \Def{store buffer machine}  and to the latter one as \Def{virtual machine}. The simulation theorem is independent of the programming language.

We continue with introducing the common parts of both machines. 
In Section \ref{sec:storebuffermachine} we describe the store buffer machine and in Section \ref{sec:virtualmachine} we then describe the virtual machine. The main reduction theorem is presented in \ref{sec:reduction}.

\medskip
Addresses @{term "a"}, values @{term "v"} and temporaries @{term "t"} are natural numbers. 
Ghost annotations for manipulating the ownership information are the following sets of addresses: the acquired addresses @{term "A"}, the unshared (local) fraction @{term "L"} of the acquired addresses, the released addresses @{term "R"} and the writable fraction @{term "W"} of the released addresses (the remaining addresses are considered read-only). 
These ownership annotations are considered as side-effects on volatile writes and interlocked operations (in case a write is performed). 
Moreover, a special ghost instruction allows to transfer ownership.
The possible status changes of an address due to these ownership transfer operations are depicted in Figure \ref{fig:ownership-transfer}. Note that ownership of an address is not directly transferred between threads, but is first released by one thread and then can be acquired by another thread.
%
\begin{figure}
\begin{center}
\begin{tikzpicture}
[auto,
 outernode/.style    = {rectangle, rounded corners, draw, text centered, minimum height=3cm, minimum width=2.7cm, fill=gray!20},
 innernode/.style  = {rectangle, rounded corners, draw, text centered, minimum height=1cm, minimum width=1cm, text width=1.5cm, fill=white}
]
\node[outernode] (owned) {};
\node[innernode] (oshared)  [below] at ($ (owned.north) -(0,0.2cm) $) {shared read-write};
\node[innernode] (onshared) [above] at ($ (owned.south) +(0,0.2cm) $) {unshared};
\node[above] at (owned.north) {owned};

\node[outernode] (unowned) [right] at ($ (owned.east) +(1.5cm,0cm) $) {};
\node[innernode] (rwshared)  [below] at ($ (unowned.north) -(0,0.2cm) $) {shared read-write};
\node[innernode] (roshared) [above] at ($ (unowned.south) +(0,0.2cm) $) {shared read-only};
\node[above] at (unowned.north) {unowned};

\path (rwshared.east) -- coordinate (middlex) (oshared.west);

\draw[->] (owned.east |- rwshared.170) -- (rwshared.170); 
  \node [above] at (rwshared.170 -| middlex) {@{term "R  W"}};

\draw[->] (unowned.west |- oshared.350) -- (oshared.350);
  \node [below] at (oshared.350 -| middlex) {@{term "A  - L"}};

\draw[->] (unowned.west |- onshared.350) -- (onshared.350);
  \node [below] at (onshared.350 -| middlex) {@{term "A  L"}};

\draw[->] (owned.east |- roshared.170) -- (roshared.170);
  \node [above] at (roshared.170 -| middlex) {@{term "R  - W"}};


\draw[->] (oshared.292) -- node {@{term "A  L"}} (onshared.68);
\draw[->] (onshared.84) -- node {@{term "A  - L"}} (oshared.276);

\node (legende) [below right] at (owned.south west) {(A)cquire, keep (L)ocal; (R)elease, mark (W)riteable };
\end{tikzpicture}
\end{center}

\caption{Ownership transfer \label{fig:ownership-transfer}}
\end{figure}
%
A memory instruction is a datatype with the following constructors:
\begin{itemize}
\item @{term "Read volatile a t"} for reading from address @{term "a"} to temporary @{term "t"}, where the Boolean @{term "volatile"} determines whether the access is volatile or not.
\item @{term "Write volatile a sop A L R W"} to write the result of evaluating the store operation @{term "sop"} at address @{term "a"}. A store operation is a pair @{term "(D,f)"}, with the domain @{term "D"} and the function @{term "f"}.
The function @{term "f"} takes temporaries @{term "θ"} as a parameter, which maps a temporary to a value. 
The subset of temporaries that is considered by function @{term "f"} is specified by the domain @{term "D"}.
We consider store operations as valid when they only depend on their domain: 
@{thm [display]"valid_sop_def" [simplified conj_to_impl [symmetric], no_vars]}
Again the Boolean @{term "volatile"} specifies the kind of memory access.
\item @{term "RMW a t sop cond ret A L R W"}, for atomic interlocked `read-modify-write' instructions (flushing the store buffer). First the value at address @{term "a"} is loaded to temporary @{term "t"}, and then the condition @{term "cond"} on the temporaries is considered to decide whether a store operation is also executed. In case of a store the function @{term "ret"}, depending on both the old value at address @{term "a"} and the new value (according to store operation @{term "sop"}), specifies the final result stored in temporary @{term "t"}. With a trivial condition @{term "cond"} this instruction also covers interlocked reads and writes.
\item @{term "Fence"}, a memory fence that flushes the store buffer. %todo: rename to flush?
\item @{term "Ghost A L R W"} for ownership transfer.
\end{itemize}

›

subsection ‹Store buffer machine \label{sec:storebuffermachine}›

text (in program) ‹
For the store buffer machine the configuration of a single thread is a tuple @{term "(p, is, θ, sb)"} consisting of the program state @{term "p"}, a memory instruction list @{term "is"}, the map of temporaries @{term "θ"} and the store buffer @{term "sb"}. A global configuration of the store buffer machine @{term "(ts, m)"} consists of a list of thread configurations @{term "ts"} and the memory @{term "m"}, which is a function from addresses to values. 


We describe the computation of the global system by the non-deterministic transition relation @{term "(ts, m, ()) sb (ts', m',())"} defined in Figure~\ref{fig:global-transitions}. 

\begin{figure}[H]
\begin{center}
@{thm [mode=Rule] store_buffer.concurrent_step.Program 
                    [where 𝒟="()" and 𝒪="()" and="()" and 𝒮="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] store_buffer.concurrent_step.Memop [where 𝒟="()" and 𝒪="()" and="()" and 𝒮="()"
                and 𝒟'="()" and 𝒪'="()" and ℛ'="()" and 𝒮'="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] store_buffer.concurrent_step.StoreBuffer [where 𝒟="()" and 𝒪="()" and="()" and 𝒮="()" and  𝒪'="()" and ℛ'="()" and 𝒮'="()",no_vars]}
\end{center}
\caption{Global transitions of store buffer machine\label{fig:global-transitions}}
\end{figure}

A transition selects a thread @{term "ts!i = (p,is,θ,sb,(),())"} and either the `program' the `memory'  or the `store buffer' makes a step defined by sub-relations. 

The program step relation is a parameter to the global 
transition relation. A program step @{thm (prem 3) "store_buffer.concurrent_step.Program" [no_vars]} takes the temporaries @{term "θ"} and the current program state @{term "p"} and makes a step by returning a new program state @{term "p'"} and an instruction list @{term "is'"} which is appended to the remaining instructions. 

A memory step @{thm (prem 3) "store_buffer.concurrent_step.Memop" [where 𝒟="()" and 𝒪="()" and="()" and 𝒮="()"
                and 𝒟'="()" and 𝒪'="()" and ℛ'="()" and 𝒮'="()",no_vars]} of a machine with store buffer may only fill its store buffer with new writes.

In a store buffer step @{thm (prem 3) "store_buffer.concurrent_step.StoreBuffer" [where 𝒟="()" and 𝒪="()" and="()" and 𝒮="()" and  𝒪'="()" and ℛ'="()" and 𝒮'="()",no_vars]} the store buffer may release outstanding writes to the memory.

The store buffer maintains the list of outstanding memory writes. 
Write instructions are appended to the end of the store buffer and emerge to memory from the front of the list. A read instructions is satisfied from the store buffer if possible. 
An entry in the store buffer is of the form @{term "Writesb volatile a sop v"} for an outstanding write (keeping the volatile flag), where operation @{term "sop"} evaluated to value @{term "v"}.

As defined in Figure \ref{fig:store-buffer-transition} a write updates the memory when it exits the store buffer.
%
\begin{figure}
\begin{center}
@{thm [mode=Axiom] SBWritesb [where rs=sb and 𝒪="()" and="()" and 𝒮="()", no_vars]}\\[0.5\baselineskip]
\end{center}
\caption{Store buffer transition \label{fig:store-buffer-transition}}
\end{figure}
%

The memory transition are defined in Figure \ref{fig:store-buffer-memory}.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] SBRead [where ghst="((),(),(),())",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SBWrite' [where ghst="((),(),(),())",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SBRMWReadOnly' [where ghst="((),(),(),())",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SBRMWWrite' [where ghst="((),(),(),())",no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] sb_memop_step.SBFence [where 𝒟="()" and 𝒪="()" and="()" and 𝒮="()",no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] sb_memop_step.SBGhost [where 𝒟="()" and 𝒪="()" and="()" and 𝒮="()",no_vars]}
\end{center}
\caption{Memory transitions of store buffer machine\label{fig:store-buffer-memory}}
\end{figure}
%
With @{term "buffered_val sb a"} we obtain the value of the last write to address @{term "a"} which is still pending in the store buffer. 
In case no outstanding write is in the store buffer we read from the memory. 
Store operations have no immediate effect on the memory but are queued in the store buffer instead. 
Interlocked operations and the fence operation require an empty store buffer, which means that it has to be flushed before the action can take place. 
The read-modify-write instruction first adds the current value at address @{term "a"} to temporary @{term "t"} and then checks the store condition @{term "cond"} on the temporaries. 
If it fails this read is the final result of the operation. 
Otherwise the store is performed. 
The resulting value of the temporary @{term "t"} is specified by the function @{term "ret"} which considers both the old and new value as input. 
The fence and the ghost instruction are just skipped.



›
subsection ‹Virtual machine \label{sec:virtualmachine}›
text (in program) ‹
The virtual machine is a sequentially consistent machine without store buffers, maintaining additional ghost state to check for the programming discipline.
A thread configuration is a tuple @{term "(p, is, θ, (), 𝒟, 𝒪,())"}, with a dirty flag @{term "𝒟"} indicating whether there may be an outstanding volatile write in the store buffer and the set of owned addresses @{term "𝒪"}. 
The dirty flag @{term "𝒟"} is considered to specify if a read is clean: for \emph{all} volatile reads the dirty flag must not be set.
The global configuration of the virtual machine @{term "(ts, m,𝒮)"} maintains a Boolean map of shared addresses @{term "𝒮"} (indicating write permission).
Addresses in the domain of mapping @{term "𝒮"} are considered shared and the set of read-only addresses is obtained  from @{term "𝒮"} by: @{thm "read_only_def" [no_vars]}

According to the rules in Fig \ref{fig:global-virtual-step} a global transition of the virtual machine 
@{term "(ts, m, 𝒮) v (ts', m', 𝒮')"} is either a program or a memory step.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] virtual.concurrent_step.Program [where sb="()" and="()", no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] virtual.concurrent_step.Memop [where sb="()" and sb'="()" and="()" and ℛ'="()",no_vars]}
\end{center}
\caption{Global transitions of virtual machine \label{fig:global-virtual-step}}
\end{figure}
The transition rules for its memory system are defined in Figure~\ref{fig:virtual-memory}.
%
\begin{figure}
\begin{center}
@{thm [mode=Axiom] VRead [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] VWriteNonVolatile [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] VWriteVolatile [where="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] VRMWReadOnly [where="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] VRMWWrite [where="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] VFence [where="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] VGhost [where="()", no_vars]}\\[0.1\baselineskip]
\end{center}
\caption{Memory transitions of the virtual machine \label{fig:virtual-memory}}
\end{figure}
%
In addition to the transition rules for the virtual machine we introduce the \emph{safety} judgment @{term "𝒪s,i (is, θ, m, 𝒟, 𝒪, 𝒮)"} in Figure~\ref{fig:safe-virtual-memory}, where @{term "𝒪s"} is the list of ownership sets obtained from the thread list @{term "ts"} and @{term "i"} is the index of the current thread.
Safety of all reachable states of the virtual machine ensures that the programming discipline is obeyed by the program and is our formal prerequisite for the simulation theorem.
It is left as a proof obligation to be discharged by means of a proper program logic for sequentially consistent executions.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] safe_direct_memop_state.Read [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] safe_direct_memop_state.WriteNonVolatile [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeWriteVolatile [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeRMWReadOnly [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeRMWWrite [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] safe_direct_memop_state.Fence [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] safe_direct_memop_state.Ghost [no_vars]}\\[0.1\baselineskip]
\end{center}
\caption{Safe configurations of a virtual machine \label{fig:safe-virtual-memory}}
\end{figure}
%
%
In the following we elaborate on the rules of Figures \ref{fig:virtual-memory} and \ref{fig:safe-virtual-memory} in parallel.
To read from an address it either has to be owned or read-only or it has to be volatile and shared. Moreover the read has to be clean.
%TODO: mention the difference distinction of 'single writer' that covered by this: for 'owned and shared' non-volatile read is ok
The memory content of address @{term "a"} is stored in temporary @{term "t"}. 
%
Non-volatile writes are only allowed to owned and unshared addresses. 
The result is written directly into the memory. 
%
A volatile write is only allowed when no other thread owns the address and the address is not marked as read-only.
Simultaneously with the volatile write we can transfer ownership as specified by the annotations @{term "A"}, @{term "L"}, @{term "R"} and @{term "W"}. 
The acquired addresses @{term "A"} must not be owned by any other thread and stem from the shared addresses or are already owned.
Reacquiring owned addresses can be used to change the shared-status via the set of local addresses @{term "L"} which have to be a subset of @{term "A"}. 
The released addresses @{term "R"} have to be owned and distinct from the acquired addresses @{term "A"}. 
After the write the new ownership set of the thread is obtained by adding the acquired addresses @{term "A"} and releasing the addresses @{term "R"}: @{term "𝒪  A - R"}. The released addresses @{term "R"} are augmented to the shared addresses @{term "S"} and the local addresses @{term "L"} are removed. We also take care about the write permissions in the shared state: the released addresses in set @{term "W"} as well as the acquired addresses are marked writable: @{term "𝒮W RA L"}. The auxiliary ternary operators to augment and subtract addresses from the sharing map are defined as follows:

@{thm [display] augment_shared_def [where S=R, no_vars]}
@{thm [display,margin=80] restrict_shared_def [no_vars]}

The read-modify-write instruction first adds the current value at address @{term "a"} to temporary @{term "t"} and then checks the store condition @{term "cond"} on the temporaries. 
If it fails this read is the final result of the operation. 
Otherwise the store is performed. 
The resulting value of the temporary @{term "t"} is specified by the function @{term "ret"} which considers both the old and new value as input. 
As the read-modify-write instruction is an interlocked operation which flushes the store buffer as a side effect the dirty flag @{term "𝒟"} is reset.
The other effects on the ghost state and the safety sideconditions are the same as for the volatile read and volatile write, respectively.

The only effect of the fence instruction in the system without store buffer is to reset the dirty flag.

The ghost instruction @{term "Ghost A L R W"} allows to transfer ownership when no write is involved \ie when merely reading from memory. It has the same safety requirements as the corresponding parts in the write instructions. 
›

subsection ‹Reduction \label{sec:reduction}›

text (in xvalid_program_progress) ‹
The reduction theorem we aim at reduces a computation of a machine with store buffers to a sequential consistent computation of the virtual machine. We formulate this as a
 simulation theorem which states that a computation of the store buffer machine @{term "(tssb,m,()) sb* (tssb',m',())"} can be simulated by a computation of the virtual machine @{term "(ts,m,𝒮) v* (ts',m',𝒮')"}. 
The main theorem only considers computations that start in an initial configuration where all store buffers are empty and end in a configuration where all store buffers are empty again. A configuration of the store buffer machine is obtained from a virtual configuration by removing all ghost components and assuming empty store buffers. This coupling relation between the thread configurations is written as @{term "tssb d ts"}. Moreover, the precondition  @{term "initialv ts 𝒮 valid"} ensures that the ghost state of the initial configuration of the virtual machine is properly initialized: the ownership sets of the threads are distinct, an address marked as read-only (according to @{term 𝒮}) is unowned and every unowned address is shared. %TODO (ommit): and the instruction lists are empty. 
Finally with @{term [names_short] "safe_reach_virtual_free_flowing (ts,m,S)"} we ensure conformance to the programming discipline by assuming that all reachable configuration in the virtual machine are safe (according to the rules in Figure~\ref{fig:safe-virtual-memory}). 
%
\begin{theorem}[Reduction]\label{thm:reduction}
@{thm [display,   mode=compact, mode=holimplnl, margin=90,names_short]  store_buffer_execution_result_sequential_consistent'_hol [where x="()" and x'="()",no_vars]}
\end{theorem}
%
This theorem captures our intiution that every result that can be obtained from a computation of the store buffer machine can also be obtained by a sequentially consistent computation. However, to prove it we need some generalizations that we sketch in the following sections. First of all the theorem is not inductive as we do not consider arbitrary intermediate configurations but only those where all store buffers are empty. For intermediate confiugrations the coupling relation becomes more involved. The major obstacle is that a volatile read (from memory) can overtake non-volatile writes that are still in the store-buffer and have not yet emerged to memory. Keep in mind that our programming discipline only ensures that no \emph{volatile} writes can be in the store buffer the moment we do a volatile read, outstanding non-volatile writes are allowed. This reordering of operations is reflected in the coupling relation for intermediate configurations as discussed in the following section.
›

section ‹Building blocks of the proof \label{sec:buildingblocks}›

text (in program) ‹
A corner stone of the proof is a proper coupling relation between an \emph{intermediate} configuration of a machine with store buffers and the virtual machine without store buffers. 
It allows us to simulate every computation step of the store buffer machine by a sequence of steps (potentially empty) on the virtual machine. 
This transformation is essentially a sequentialization of the trace of the store buffer machine. 
When a thread of the store buffer machine executes a non-volatile operation, it only accesses memory which is not modified by any other thread (it is either owned or read-only). 
Although a non-volatile store is buffered, we can immediately execute it on the virtual machine, as there is no competing store of another thread. 
However, with volatile writes we have to be careful, since concurrent threads may also compete with some volatile write to the same address. 
At the moment the volatile write enters the store buffer we do not yet know when it will be issued to memory and how it is ordered relatively to other outstanding writes of other threads.
We therefore have to suspend the write on the virtual machine from the moment it enters the store buffer to the moment it is issued to memory.
For volatile reads our programming discipline guarantees that there is no volatile write in the store buffer by flushing the store buffer if necessary. 
So there are at most some outstanding non-volatile writes in the store buffer, which are already executed on the virtual machine, as described before.
One simple coupling relation one may think of is to suspend the whole store buffer as not yet executed intructions of the virtual machine. However, consider the following scenario. A thread is reading from a volatile address. 
It can still have non-volatile writes in its store buffer. 
Hence the read would be suspended in the virutal machine, and other writes to the address (e.g. interlocked or volatile writes of another thread) could invalidate the value.
Altogether this suggests the following refined coupling relation: the state of the virtual machine is obtained from the state of the store buffer machine, by executing each store buffer until we reach the first volatile write. 
The remaining store buffer entries are suspended as instructions. As we only execute non volatile writes the order in which we execute the store buffers should be irrelevant.
This coupling relation allows a volatile read to be simulated immediately on the virtual machine as it happens on the store buffer machine. 
 
From the viewpoint of the memory the virtual machine is ahead of the store buffer machine, as leading non-volatile writes already took effect on the memory of the virtual machine while they are still pending in the store buffer. 
However, if there is a volatile write in the store buffer the corresponding thread in the virtual machine is suspended until the write leaves the store buffer. 
So from the viewpoint of the already executed instructions the store buffer machine is ahead of the virtual machine. To keep track of this delay we introduce a variant of the store buffer machine below, which maintains the history of executed instructions in the store buffer (including reads and program steps). Moreover, the intermediate machine also maintains the ghost state of the virtual machine to support the coupling relation. We also introduce a refined version of the virutal machine below, which we try to motivate now.
Esentially the programming discipline only allows races between volatile (or interlocked) operations. By race we mean two competing memory accesses of different threads of which at least one is a write. 
For example the discipline guarantees that a volatile read may not be invalidated by a non-volatile write of another thread. 
While proving the simulation theorem this manifests in the argument that a read of the store-buffer machine and the virtual machine sees the same value in both machines: the value seen by a  read in the store buffer machine stays valid as long as it has not yet made its way out in the virtual machine. 
To rule out certain races from the execution traces we make use of the programming discipline, which is formalized in the safety of all reachable configurations of the virtual machine. Some races can be ruled out by continuing the computation of the virtual machine until we reach a safety violation. 
However, some cannot be ruled out by the future computation of the current trace, but can be invalidated by a safety violation of another trace that deviated from the current one at some point in the past. Consider two threads. 
Thread 1 attempts to do a volatile read from address @{term a} which is currently owned (and not shared) by thread 2, which attempts to do a non-volatile write on @{term a} with value @{term "42::nat"} and then release the address. 
In this configuration there is already a safety violation. Thread 1 is not allowed to perform a volatile read from an address that is not shared. 
However, when Thread 2 has executed his update and has released ownership (both are non-volatile operations) there is no safety violation anymore. 
Unfortunately this is the state of the virtual machine when we consider the instructions of Thread 2 to be in the store buffer. The store buffer machine and the virtual machine are out of sync. 
Whereas in the virtual machine Thread 1 will already read @{term "42::nat"} (all non-volatile writes are already executed in the virtual machine), the non-volatile write may still be pending in the store buffer of Thread 2 and hence Thread 1 reads the old value in the store buffer machine.
This kind of issues arise when a thread has released ownership in the middle of non-volatile operations of the virtual machine, but the next volatile write of this thread has not yet made its way out of the store buffer. 
When another thread races for the released address in this situation there is always another scheduling of the virtual machine where the release has not yet taken place and we get a safety violation. 
To make these safety violations visible until the next volatile write we introduce another ghost component that keeps track of the released addresses. 
It is augmented when an ghost operation releases an address and is reset as the next volatile write is reached.
Moreover, we refine our rules for safety to take these released addresses into account. 
For example, a write to an released address of another thread is forbidden. 
We refer to these refined model as \emph{delayed releases} (as no other thread can acquire the address as long as it is still in the set of released addresses) and to our original model as \emph{free flowing releases} (as the effect of a release immediate takes place at the point of the ghost instruction). 
Note that this only affects ownership transfer due to the @{term Ghost} instruction. 
Ownership transfer together with volatile (or interlocked) writes happen simultaneously in both models.

Note that the refined rules for delayed releases are just an intermediate step in our proof. 
They do not have to be considered for the final programming discipline. As sketched above we can show in a separate theorem that a safety violation in a trace with respect to delayed releases implies a safety violation of a (potenitally other) trace with respect to free flowing releases. Both notions of safety collaps in all configurations where there are no released addresses, like the initial state. So if all reachable configurations are safe with respect to free flowing releases they are also safe with respect to delayed releases. This allows us to use the stricter policy of delayed releases for the simulation proof.
Before continuing with the coupling relation, we introduce the refined intermediate models for delayed releases and store buffers with history information. 

›

subsection ‹Intermediate models›

text (in program) ‹
We begin with the virtual machine with delayed releases, for which the memory transitions 
@{term "(is,θ,(),m,𝒟,𝒪,,𝒮)  (is',θ',(),m',𝒟',𝒪',ℛ',𝒮')"}
are defined Figure \ref{fig:virtual-delayed-memory}.
%
\begin{figure}
\begin{center}
@{thm [mode=Axiom] DRead [where x="()",no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] DWriteNonVolatile [where x="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule,names_short] DWriteVolatile [where x="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule,names_short] DRMWReadOnly [where x="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule,names_short] DRMWWrite [where x="()",no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom,names_short] direct_memop_step.Fence [where x="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] DGhost [where x="()",no_vars]}\\[0.1\baselineskip]
\end{center}
\caption{Memory transitions of the virtual machine with delayed releases\label{fig:virtual-delayed-memory}}
\end{figure}
%
The additional ghost component @{term ""} is a mapping from addresses to a Boolean flag. If an address is in the domain of @{term } it was released. The boolean flag is considered to figure out if the released address was previously shared or not. In case the flag is @{term True} it was shared otherwise not. This subtle distinction is necessary to properly handle volatile reads. A volatile read from an address owned by another thread is fine as long as it is marked as shared. The released addresses @{term } are reset at every volatile write as well as interlocked operations and the fence instruction. They are augmented at the ghost instruction taking the sharing information into account:

@{thm [display] augment_rels_def [where S="dom 𝒮", no_vars]}

If an address is freshly released (@{term "a  R"} and @{term " a = None"}) the flag is set according to @{term "dom 𝒮"}. Otherwise the flag becomes @{term "Some False"} in case the released address is currently unshared.
Note that with this definition @{term " a = Some False"} stays stable upon every new release and we do not loose information about a release of an unshared address.

The global transition @{term "(ts, m, s) d (ts',m',s')"} are analogous to the rules in Figure \ref{fig:global-virtual-step} replacing the memory transtions with the refined version for delayed releases.

The safety judgment for delayed releases @{term "𝒪s,ℛs,i (is, θ, m, 𝒟, 𝒪, 𝒮)"} is defined in Figure \ref{fig:safe-delayed}. Note the additional component @{term ℛs} which is the list of release maps of all threads.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] safe_delayed_direct_memop_state.Read [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] safe_delayed_direct_memop_state.WriteNonVolatile [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeDelayedWriteVolatile [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeDelayedRMWReadOnly [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeDelayedRMWWrite [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] safe_delayed_direct_memop_state.Fence [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] safe_delayed_direct_memop_state.Ghost [no_vars]}\\[0.1\baselineskip]
@{thm [mode=Rule] safe_delayed_direct_memop_state.Nil [no_vars]}\\[0.1\baselineskip]
\end{center}
\caption{Safe configurations of a virtual machine (delayed-releases) \label{fig:safe-delayed}}
\end{figure}
%
The rules are strict extensions of the rules in Figure \ref{fig:safe-virtual-memory}: writing or acquiring an address @{term a} is only allowed if the address is not in the release set of another thread (@{term "a  dom (ℛs!j)"}); reading from an address is only allowed if it is not released by another thread while it was unshared (@{term "(ℛs!j) a  Some False"}). 

For the store buffer machine with history information we not only put writes into the store buffer but also record reads, program steps and ghost operations. 
This allows us to restore the necessary computation history of the store buffer machine and relate it to the virtual machine which may fall behind the store buffer machine during execution. 
Altogether an entry in the store buffer is either a
\begin{itemize}
\item @{term "Readsb volatile a t v"}, recording a corresponding read from address @{term "a"} which loaded the value @{term "v"} to temporary @{term "t"}, or a 
\item @{term "Writesb volatile a sop v"} for an outstanding write, where operation @{term "sop"} evaluated to value @{term "v"}, or of the form

\item @{term "Progsb p p' is'"}, recording a program transition from @{term "p"} to @{term "p'"} which issued instructions @{term "is'"}, or of the form
\item @{term "Ghostsb A L R W"}, recording a corresponding ghost operation.
\end{itemize}
As defined in Figure \ref{fig:store-buffer-transitions} a write updates the memory when it exits the store buffer, all other store buffer entries may only have an effect on the ghost state. The effect on the ownership information is analogous to the corresponding operations in the virtual machine.
%
\begin{figure}
\begin{center}
@{thm [mode=Axiom] WritesbNonVolatile [where rs=sb, no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule, names_short] WritesbVolatile [where rs=sb,  no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] flush_step.Readsb [where rs=sb, no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] flush_step.Progsb [where rs=sb, no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] Ghostsb [where rs=sb, no_vars]} 
\end{center}
\caption{Store buffer transitions with history\label{fig:store-buffer-transitions}}
\end{figure}
%
The memory transitions defined in Figure \ref{fig:store-buffer-history-memory} are straightforward extensions 
of the store buffer transitions of Figure \ref{fig:store-buffer-history-memory} augmented with ghost state 
and recording history information in the store buffer. Note how we deal with the ghost state. 
Only the dirty flag is updated when the instruction enters the store buffer, the ownership transfer 
takes effect when the instruction leaves the store buffer.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] SBHRead [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SBHWriteNonVolatile' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SBHWriteVolatile' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule,names_short] SBHRMWReadOnly' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule,names_short] SBHRMWWrite' [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom,names_short] sbh_memop_step.SBHFence [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] SBHGhost' [no_vars]}
\end{center}
\caption{Memory transitions of store buffer machine with history\label{fig:store-buffer-history-memory}}
\end{figure}
%
The global transitions @{term "(tssbh, m, 𝒮) sbh (tssbh',m',𝒮')"} are analogous to the rules in Figure \ref{fig:global-transitions} replacing the memory transtions and store buffer transtiontions accordingly.
›

subsection ‹Coupling relation \label{sec:couplingrelation}›

text (in program) ‹
After this introduction of the immediate models we can proceed to the details of the coupling relation, which relates configurations of the store buffer machine with histroy and the virtual machine with delayed releases.
Remember the basic idea of the coupling relation: the state of the virtual machine is obtained from the state of the store buffer machine, by executing each store buffer until we reach the first volatile write. The remaining store buffer entries are suspended as instructions. The instructions now also include the history entries for reads, program steps and ghost operations.
The suspended reads are not yet visible in the temporaries of the virtual machine. 
Similar the ownership effects (and program steps) of the suspended operations are not yet visible in the virtual machine.
The coupling relation between the store buffer machine and the virtual machine is illustrated in Figure~\ref{fig:coupling-relation-pic}. The threads issue instructions to the store buffers from the right and the instructions emerge from the store buffers to main memory from the left. The dotted line illustrates the state of the virtual machines memory. It is obtained from the memory of the store buffer machine by executing the purely non-volatile prefixes of the store buffers. The remaining entries of the store buffer are still (suspended) instructions in the virtual machine.

\begin{figure}
\centering
\begin{tikzpicture}
\tikzstyle{sbnodel}=[shape=rectangle, draw=black, text badly centered,  outer sep=0cm]
\tikzstyle{sbnoder}=[shape=rectangle, draw=black, text ragged, outer sep=0cm]
\tikzstyle{nonvolatile}=[fill=gray!10]
\tikzstyle{virtual}=[dotted]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Store buffers and instructions %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\node (sbl0) [style=sbnodel,style=nonvolatile,text width=1.3cm] {nv};
\node (sbr0) [style=sbnoder,text width=1.7cm, right] at(sbl0.east) {v};
\node (ins0) [right] at ($ (sbr0.east) $) {thread $0$: $i_0^0$, $i_0^1$, $\dots$};

\node (sbl1) [style=sbnodel,style=nonvolatile,text width=2.0cm,below right] at ($ (sbl0.south west) -(0,0.6cm) $) {nv};
\node (sbr1) [style=sbnoder,text width=1.0cm, right] at(sbl1.east) {v};
\node (ins1) [right] at ($ (sbr1.east) $) {thread $i$: $i_i^0$, $i_i^1$, $\dots$};


\node (sbl2) [style=sbnodel,style=nonvolatile,text width=1.7cm,below right] at ($ (sbl1.south west) -(0,0.6cm) $) {nv};
\node (sbr2) [style=sbnoder,text width=1.3cm, right] at(sbl2.east) {v};
\node (ins2) [right] at ($ (sbr2.east) $) {thread $j$: $i_j^0$, $i_j^1$, $\dots$};

\node (sbl3) [style=sbnodel,style=nonvolatile,text width=1.4cm,below right] at ($ (sbl2.south west) -(0,0.6cm) $) {nv};
\node (sbr3) [style=sbnoder,text width=1.6cm, right] at(sbl3.east) {v};
\node (ins3) [right] at ($ (sbr3.east) $) {thread $n$: $i_n^0$, $i_n^1$, $\dots$};

\path (sbr1.north east) to node [near end,left] {$\vdots$} (sbr0.south east);
\path (sbr2.north east) to node [near end,left] {$\vdots$} (sbr1.south east);
\path (sbr3.north east) to node [near end,left] {$\vdots$} (sbr2.south east);

\node (sblabel)[above]  at ($ (sbr0.north west) +(0,0.6cm)$) {$\leftarrow$ store buffers};
\node (inslabel)[above]  at ($ (sbr0.north east) +(1.5cm,0.6cm)$) {$\leftarrow$ instructions};

%%%%%%%%%%
% Memory %
%%%%%%%%%%
\coordinate (memNorthWest) at ($ (sbl0.north west) -(2.0cm,0cm) $);
\coordinate (memSouthEast) at ($ (sbl3.south west) -(0.5cm,0cm) $);
\filldraw[style=nonvolatile,rounded corners]  (memNorthWest) rectangle  (memSouthEast) node [midway] {@{term "msbh"}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Virtual memory boundaries %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\draw [style=virtual,out=90,in=-90](sbr1.north west) to (sbr0.south west);
\draw [style=virtual,out=90,in=-90](sbr2.north west) to (sbr1.south west);
\draw [style=virtual,out=90,in=-90](sbr3.north west) to (sbr2.south west);

\draw [style=virtual] ($ (memNorthWest) +(0,0.4cm) $) to ($ (sbr0.north west) + (-0.3,0.4)$)[out=0,in=90] to ($ (sbr0.north west)$);
\draw [style=virtual]($ (memNorthWest |- memSouthEast) +(0,-0.8cm) $) to node[midway,above]{@{term m}} ($ (sbr3.south west) + (-0.3,-0.8)$)[out=0,in=90]
  to ($ (sbr3.south west)$);

\node (execslabel)[below]  at ($ (sbl3.south)$) {executed};
\node (suspendslabel)[below]  at ($ (sbr3.south)$) {suspended};

\end{tikzpicture}

\caption{Illustration of coupling relation \label{fig:coupling-relation-pic}}
\end{figure}


Consider the following configuration of a thread @{term "tssbh ! j"} in the store buffer machine, where @{term "ik"} are the instructions and @{term "sk"} the store buffer entries. 
Let @{term "sv"} be the first volatile write in the store buffer. 
Keep in mind that new store buffer entries are appended to the end of the list and entries exit the store buffer and are issued to memory from the front of the list.
%
\begin{center} 
@{term "tssbh ! j = (p,[i1,,in], θ, [s1,,sv,s𝔳,,sm], 𝒟, 𝒪, )"}
\end{center} 
%
The corresponding configuration @{term "ts ! j"} in the virtual machine is obtained by suspending all store buffer entries beginning at @{term "sv"} to the front of the instructions. 
A store buffer @{term "Readsb"} / @{term "Writesb"} / @{term "Ghostsb"} is converted to a  @{term "Read"} / @{term "Write"} / @{term "Ghost"} instruction. 
We take the freedom to make this coercion implicit in the example. 
The store buffer entries preceding @{term "sv"} have already made their way to memory, whereas the suspended read operations are not yet visible in the temporaries @{term "θ'"}. Similar, the suspended updates to the ownership sets and dirty flag are not yet recorded in @{term "𝒪'"}, @{term "ℛ'"} and @{term "𝒟'"}.
%
\begin{center} 
@{term "ts ! j =(p,[sv,s𝔳,,sm,i1,,in], θ', (), 𝒟', 𝒪',ℛ')"}
\end{center} 
%
This example illustrates that the virtual machine falls behind the store buffer machine in our simulation, as store buffer instructions are suspended and reads (and ghost operations) are delayed and not yet visible in the temporaries (and the ghost state).
This delay can also propagate to the level of the programming language, which communicates with the memory system by reading the temporaries and issuing new instructions. 
For example the control flow can depend on the temporaries, which store the result of branching conditions. 
It may happen that the store buffer machine already has evaluated the branching condition by referring to the values in the store buffer, whereas the virtual machine still has to wait. 
Formally this manifests in still undefined temporaries. 
Now consider that the program in the store buffer machine makes a step from @{term "p"} to @{term "(p',is')"}, which results in a thread configuration where the program state has switched to @{term "p'"}, the instructions @{term "is'"} are appended and the program step is recorded in the store buffer:
%
\begin{center} 
@{term "tssbh' ! j = (p',[i1,,in]@is', θ, [s1,,sv,,sm,Progsb p p' is'], 𝒟, 𝒪, )"}
\end{center} 
%
The virtual machine however makes no step, since it still has to evaluate the suspended instructions before making the program step. 
The instructions @{term "is'"} are not yet issued and the program state is still @{term "p"}. 
We also take these program steps into account in our final coupling relation @{thm (concl) sim_config' [no_vars]}, defined in Figure~\ref{fig:coupling-relation}.
%
\begin{figure}
\begin{center}
\begin{minipage}{10cm}
\inferrule{@{thm (prem 1) sim_config' [no_vars]}\\
           @{thm (prem 2) sim_config' [no_vars]}\\
           @{thm (prem 3) sim_config' [no_vars]}\\
           \parbox{9.8cm}{@{thm [break,mode=letnl,margin=80] (prem 4) sim_config' [simplified restrict_map_inverse, no_vars]}}}
%
          {@{thm (concl) sim_config' [no_vars]}}
\end{minipage}
\end{center}
\caption{Coupling relation \label{fig:coupling-relation}}
\end{figure}
% 
We denote the already simulated store buffer entries by @{term "Bind execs. execs"} and the suspended ones by @{term "Bind suspends. suspends"}.
The function @{term "instrs"} converts them back to instructions, which are a prefix of the instructions of the virtual machine. 
We collect the additional instructions which were issued by program instructions but still recorded in the remainder of the store buffer with function @{term "prog_instrs"}. 
These instructions have already made their way to the instructions of the store buffer machine but not yet on the virtual machine. 
This situation is formalized as @{term "Bind suspends issbh is. instrs suspends @ issbh = is @ prog_instrs suspends"}, where @{term "Bind is. is"} are the instructions of the virtual machine. 
The program state of the virtual machine is either the same as in the store buffer machine or the first program state recorded in the suspended part of the store buffer.
This state is selected by @{const "hd_prog"}. 
The temporaries of the virtual machine are obtained by removing the suspended reads from @{term "θ"}. 
The memory is obtained by executing all store buffers until the first volatile write is hit, excluding it. Thereby only non-volatile writes are executed, which are all thread local, and hence could be executed in any order with the same result on the memory. Function @{const "flush_all_until_volatile_write"} executes them in order of appearance.
Similarly the sharing map of the virtual machine is obtained by executing all store buffers until the first volatile write via the function @{const "share_all_until_volatile_write"}. For the local ownership set @{term "𝒪sbh"} the auxiliary function @{term "acquire"} calculates the outstanding effect of the already simulated parts of the store buffer. Analogously @{term "release"} calculates the effect for the released addresses @{term "sbh"}.


›

subsection ‹Simulation \label{sec:simulation}›

text (in xvalid_program_progress) ‹
Theorem \ref{thm:simulation} is our core inductive simulation theorem. 
Provided that all reachable states of the virtual machine (with delayed releases) are safe, a step of the store buffer machine (with history) can be simulated by a (potentially empty) sequence of steps on the virtual machine, maintaining the coupling relation and an invariant on the configurations of the store buffer machine.
%
\begin{theorem}[Simulation]\label{thm:simulation}
@{thm [display,  mode=holimplnl,margin=100]  simulation_hol [no_vars]}
\end{theorem}
%
In the following we discuss the invariant @{term [names_short] "invariant tssbh Ssbh msbh"}, where we commonly refer to a thread configuration @{term "tssbh!i = (p,is,θ,sb,𝒟,𝒪,)"} for @{term "i < length tssbh"}. 
By outstanding references we refer to read and write operations in the store buffer. 
The invariant is a conjunction of several sub-invariants grouped by their content:

@{thm [display, names_short, mode=compact, margin=100] invariant_grouped_def [of tssbh Ssbh msbh]}
%TODO make grouping formally, hide program step in valid_history

\paragraph{Ownership.} 
\begin{inparaenum}
\item \label{inv-ownership:owned-or-read-only} For every thread all outstanding non-volatile references have to be owned or refer to read-only memory.
\item Every outstanding volatile write is not owned by any other thread. 
\item Outstanding accesses to read-only memory are not owned.
\item \label{inv-ownership:distinct-ownership} The ownership sets of every two different threads are distinct.
\end{inparaenum}

\paragraph{Sharing.}
\begin{inparaenum}
\item \label{inv-sharing:non-volatile-writes-unshared} All outstanding non volatile writes are unshared. 
\item All unowned addresses are shared.
\item No thread owns read-only memory.
\item The ownership annotations of outstanding ghost and write operations are consistent (\eg released addresses are owned at the point of release).
\item \label{inv-sharing:no-write-to-read-only-memory} There is no outstanding write to read-only memory.
\end{inparaenum}

\paragraph{Temporaries.} Temporaries are modeled as an unlimited store for temporary registers. We require certain distinctness and freshness properties for each thread.
\begin{inparaenum}
\item The temporaries referred to by read instructions are distinct.
\item The temporaries referred to by reads in the store buffer are distinct.
\item Read and write temporaries are distinct.
\item Read temporaries are fresh, \ie are not in the domain of @{term "θ"}.
\end{inparaenum}

\paragraph{Data dependency.} Data dependency means that store operations may only depend on \emph{previous} read operations. For every thread we have:
\begin{inparaenum}
\item Every operation @{term "(D, f)"} in a write instruction or a store buffer write is valid according to @{term "valid_sop (D, f)"}, \ie function @{term "f"} only depends on domain @{term "D"}.
\item For every suffix of the instructions of the form @{term "Write volatile a (D,f) A L R W#is"} the domain @{term "D"} is distinct from the temporaries referred to by future read instructions in @{term "is"}.
\item The outstanding writes in the store buffer do not depend on the read temporaries still in the instruction list.
\end{inparaenum}

\paragraph{History.} The history information  of program steps and  read operations we record in the store buffer have to be consistent with the trace. For every thread:
\begin{inparaenum}
\item The value stored for a non volatile read is the same as the last write to the same address in the store buffer or the value in memory, in case there is no write in the buffer. 
\item All reads have to be clean. This results from our flushing policy. Note that the value recorded for a volatile read in the initial part of the store buffer (before the first volatile write), may become stale with respect to the memory. Remember that those parts of the store buffer are already executed in the virtual machine and thus cause no trouble.
\item For every read the recorded value coincides with the corresponding value in the temporaries.
\item For every @{term "Writesb volatile a (D,f) v A L R W"} the recorded value @{term "v"} coincides with @{term "f θ"}, and domain @{term "D"} is subset of @{term "dom θ"} and is distinct from the following read temporaries. Note that the consistency of the ownership annotations is already covered by the aforementioned invariants.
\item For every suffix in the store buffer of the form @{term "Progsb p1 p2 is'#sb'"}, either @{term "p1 = p"} in case there is no preceding program node in the buffer or it corresponds to the last program state recorded there. 
Moreover, the program transition @{term "θ|`(- read_tmps sb') p1 p (p2,is')"} is possible, \ie it was possible to execute the program transition at that point.
\item The program configuration @{term "p"} coincides with the last program configuration recorded in the store buffer.
\item As the instructions from a program step are at the one hand appended to the instruction list and on the other hand recorded in the store buffer, we have for every suffix @{term "sb'"} of the store buffer: @{term "is'. instrs sb' @ is = is' @ prog_instrs sb'"}, \ie the remaining instructions @{term "is"} correspond to a suffix of the recorded instructions @{term "prog_instrs sb'"}.
\end{inparaenum}

\paragraph{Flushes.} If the dirty flag is unset there are no outstanding volatile writes in the store buffer.

\paragraph{Program step.} The program-transitions are still a parameter of our model. 
In order to make the proof work, we have to assume some of the invariants also for the program steps. 
We allow the program-transitions to employ further invariants on the configurations, these are modeled by the parameter @{term "valid"}. 
For example, in the instantiation later on the program keeps a counter for the temporaries, for each thread. 
We maintain distinctness of temporaries by restricting all temporaries occurring in the memory system to be below that counter, which is expressed by instantiating @{term "valid"}. 
Program steps, memory steps and store buffer steps have to maintain @{term "valid"}. 
Furthermore we assume the following properties of a program step:
\begin{inparaenum}
\item The program step generates fresh, distinct read temporaries, that are neither in @{term "θ"} nor in the store buffer temporaries of the memory system.
\item The generated memory instructions respect data dependencies, and are valid according to @{term "valid_sop"}.

%TODO: maybe we can omit the formal stuff, intuition should be clear, depends on what we write on PIMP.
\end{inparaenum}

\paragraph{Proof sketch.} We do not go into details but rather first sketch the main arguments for simulation of a step in the store buffer machine by a potentially empty sequence of steps in the virtual machine, maintaining the coupling relation. Second we exemplarically focus on some cases to illustrate common arguments in the proof.
The first case distinction in the proof is on the global transitions in Figure~\ref{fig:global-transitions}. 
%
\begin{inparaenum}
\item \emph{Program step}: 
we make a case distinction whether there is an outstanding volatile write in the store buffer or not. 
If not the configuration of the virtual machine corresponds to the executed store buffer and we can make the same step. 
Otherwise the virtual machine makes no step as we have to wait until all volatile writes have exited the store buffer.
%
\item \emph{Memory step}: 
we do case distinction on the rules in Figure~\ref{fig:store-buffer-history-memory}. 
For read, non volatile write and ghost instructions we do the same case distinction as for the program step. 
If there is no outstanding volatile write in the store buffer we can make the step, otherwise we have to wait. 
When a volatile write enters the store buffer it is suspended until it exists the store buffer. Hence we do no step in the virtual machine.
The read-modify-write and the fence instruction can all be simulated immediately since the store buffer has to be empty.
%
\item \emph{Store Buffer step}:
we do case distinction on the rules in Figure~\ref{fig:store-buffer-transitions}. 
When a read, a non volatile write, a ghost operation or a program history node exits the store buffer, the virtual machine does not have to do any step since these steps are already visible. 
When a volatile write exits the store buffer, we execute all the suspended operations (including reads, ghost operations and program steps) until the next suspended volatile write is hit. This is possible since all writes are non volatile and thus memory modifications are thread local. 
\end{inparaenum}

In the following we exemplarically describe some cases in more detail to give an impression on the typical arguments in the proof.
We start with a configuration @{term "csbh=(tssbh,msbh,𝒮sbh)"} of the store buffer machine, where the next instruction to be executed is a 
read of thread @{term i}: @{term "Readsb volatile a t"}. The configuration of the virtual machine is @{term "cfg=(ts,m,𝒮)"}. 
We have to simulate this step on the virtual machine and can make use of 
the coupling relations @{term "(tssbh,msbh,𝒮sbh)  (ts,m,𝒮)"},  the invariants  @{term "invariant tssbh 𝒮sbh msbh"} and the safety of all reachable states of the virtual machine: @{term "safe_reach_direct_delayed (ts,m,𝒮)"}. The state of the store buffer machine and the coupling with the volatile machine is depicted in Figure~\ref{fig:coupling-i-read}. Note that if there are some suspended instructions in thread @{term i}, we cannot directly exploit the 'safety of the read', as the virtual machine has not yet reached the state where thread @{term i} is poised to do the read. But fortunately we have safety of the virtual machien of all reachable states. Hence we can just  execute all suspended instructions of thread @{term i} until we reach the read. We refer to this configuration of the virtual machine as @{term "cfg''=(ts'',m'',𝒮'')"}, which is depicted in Figure~\ref{fig:coupling-i-read-forward}.

\begin{figure}
\centering
\begin{tikzpicture}
\tikzstyle{sbnodel}=[shape=rectangle, draw=black, text badly centered,  outer sep=0cm]
\tikzstyle{sbnoder}=[shape=rectangle, draw=black, text ragged, outer sep=0cm]
\tikzstyle{nonvolatile}=[fill=gray!10]
\tikzstyle{virtual}=[dotted]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Store buffers and instructions %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\node (sbl0) [style=sbnodel,style=nonvolatile,text width=1.3cm] {nv};
\node (sbr0) [style=sbnoder,text width=1.7cm, right] at(sbl0.east) {v};
\node (ins0) [right] at ($ (sbr0.east) $) {thread $0$: $i_0^0$, $i_0^1$, $\dots$};

\node (sbl1) [style=sbnodel,style=nonvolatile,text width=2.0cm,below right] at ($ (sbl0.south west) -(0,0.6cm) $) {nv};
\node (sbr1) [style=sbnoder,text width=1.0cm, right] at(sbl1.east) {v};
\node (ins1) [right] at ($ (sbr1.east) $) {thread $i$: @{term "Readsb volatile a t"},$\dots$};


\node (sbl2) [style=sbnodel,style=nonvolatile,text width=1.7cm,below right] at ($ (sbl1.south west) -(0,0.6cm) $) {nv};
\node (sbr2) [style=sbnoder,text width=1.3cm, right] at(sbl2.east) {v};
\node (ins2) [right] at ($ (sbr2.east) $) {thread $j$: $i_j^0$, $i_j^1$, $\dots$};

\node (sbl3) [style=sbnodel,style=nonvolatile,text width=1.4cm,below right] at ($ (sbl2.south west) -(0,0.6cm) $) {nv};
\node (sbr3) [style=sbnoder,text width=1.6cm, right] at(sbl3.east) {v};
\node (ins3) [right] at ($ (sbr3.east) $) {thread $n$: $i_n^0$, $i_n^1$, $\dots$};

\path (sbr1.north east)  to node [near end,left] {$\vdots$} (sbr0.south east);
\path (sbr2.north east)  to node [near end,left] {$\vdots$} (sbr1.south east);
\path (sbr3.north east)  to node [near end,left] {$\vdots$} (sbr2.south east);

\node (sblabel)[above]  at ($ (sbr0.north west) +(0,0.6cm)$) {$\leftarrow$ store buffers};
\node (inslabel)[above]  at ($ (sbr0.north east) +(1.5cm,0.6cm)$) {$\leftarrow$ instructions};

%%%%%%%%%%
% Memory %
%%%%%%%%%%
\coordinate (memNorthWest) at ($ (sbl0.north west) -(2.0cm,0cm) $);
\coordinate (memSouthEast) at ($ (sbl3.south west) -(0.5cm,0cm) $);
\filldraw[style=nonvolatile,rounded corners]  (memNorthWest) rectangle  (memSouthEast) node [midway] {@{term "msbh"}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Virtual memory boundaries %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\draw [style=virtual,out=90,in=-90](sbr1.north west) to (sbr0.south west);
\draw [style=virtual,out=90,in=-90](sbr2.north west) to (sbr1.south west);
\draw [style=virtual,out=90,in=-90](sbr3.north west) to (sbr2.south west);

\draw [style=virtual] ($ (memNorthWest) +(0,0.4cm) $) to ($ (sbr0.north west) + (-0.3,0.4)$)[out=0,in=90] to ($ (sbr0.north west)$);
\draw [style=virtual]($ (memNorthWest |- memSouthEast) +(0,-0.8cm) $) to node[midway,above]{@{term m}} ($ (sbr3.south west) + (-0.3,-0.8)$)[out=0,in=90]
  to ($ (sbr3.south west)$);

\node (execslabel)[below]  at ($ (sbl3.south)$) {executed};
\node (suspendslabel)[below]  at ($ (sbr3.south)$) {suspended};

\end{tikzpicture}

\caption{Thread @{term i} poised to read \label{fig:coupling-i-read}}
\end{figure}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\begin{figure}
\centering
\begin{tikzpicture}
\tikzstyle{sbnodel}=[shape=rectangle, draw=black, text badly centered,  outer sep=0cm]
\tikzstyle{sbnoder}=[shape=rectangle, draw=black, text ragged, outer sep=0cm]
\tikzstyle{nonvolatile}=[fill=gray!10]%todo rename to executed?
\tikzstyle{virtual}=[dotted]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Store buffers and instructions %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\node (sbl0) [style=sbnodel,style=nonvolatile,text width=1.3cm] {nv};
\node (sbr0) [style=sbnoder,text width=1.7cm, right] at(sbl0.east) {v};
\node (ins0) [right] at ($ (sbr0.east) $) {thread $0$: $i_0^0$, $i_0^1$, $\dots$};

\node (sbl1) [style=sbnodel,style=nonvolatile,text width=2.0cm,below right] at ($ (sbl0.south west) -(0,0.6cm) $) {nv};
\node (sbr1) [style=sbnoder,style=nonvolatile,text width=1.0cm, right] at(sbl1.east) {v};
\node (ins1) [right] at ($ (sbr1.east) $) {thread $i$: @{term "Readsb volatile a t"},$\dots$};


\node (sbl2) [style=sbnodel,style=nonvolatile,text width=1.7cm,below right] at ($ (sbl1.south west) -(0,0.6cm) $) {nv};
\node (sbr2) [style=sbnoder,text width=1.3cm, right] at(sbl2.east) {v};
\node (ins2) [right] at ($ (sbr2.east) $) {thread $j$: $i_j^0$, $i_j^1$, $\dots$};

\node (sbl3) [style=sbnodel,style=nonvolatile,text width=1.4cm,below right] at ($ (sbl2.south west) -(0,0.6cm) $) {nv};
\node (sbr3) [style=sbnoder,text width=1.6cm, right] at(sbl3.east) {v};
\node (ins3) [right] at ($ (sbr3.east) $) {thread $n$: $i_n^0$, $i_n^1$, $\dots$};

\path (sbr1.north east)  to node [near end,left] {$\vdots$} (sbr0.south east);
\path (sbr2.north east)  to node [near end,left] {$\vdots$} (sbr1.south east);
\path (sbr3.north east)  to node [near end,left] {$\vdots$} (sbr2.south east);

\node (sblabel)[above]  at ($ (sbr0.north west) +(0,0.6cm)$) {$\leftarrow$ store buffers};
\node (inslabel)[above]  at ($ (sbr0.north east) +(1.5cm,0.6cm)$) {$\leftarrow$ instructions};

%%%%%%%%%%
% Memory %
%%%%%%%%%%
\coordinate (memNorthWest) at ($ (sbl0.north west) -(2.0cm,0cm) $);
\coordinate (memSouthEast) at ($ (sbl3.south west) -(0.5cm,0cm) $);
\filldraw[style=nonvolatile,rounded corners]  (memNorthWest) rectangle  (memSouthEast) node [midway] {@{term "msbh"}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Virtual memory boundaries %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\draw [style=virtual,out=90,in=-90](sbr1.north east) to (sbr0.south west);
\draw [style=virtual,out=90,in=-90](sbr2.north west) to (sbr1.south east);
\draw [style=virtual,out=90,in=-90](sbr3.north west) to (sbr2.south west);

\draw [style=virtual] ($ (memNorthWest) +(0,0.4cm) $) to ($ (sbr0.north west) + (-0.3,0.4)$)[out=0,in=90] to ($ (sbr0.north west)$);
\draw [style=virtual]($ (memNorthWest |- memSouthEast) +(0,-0.8cm) $) to node[midway,above]{@{term m}} ($ (sbr3.south west) + (-0.3,-0.8)$)[out=0,in=90]
  to ($ (sbr3.south west)$);

\node (execslabel)[below]  at ($ (sbl3.south)$) {executed};
\node (suspendslabel)[below]  at ($ (sbr3.south)$) {suspended};

\end{tikzpicture}

\caption{Forwarded computation of virtual machine  \label{fig:coupling-i-read-forward}}
\end{figure}



For now we want to consider the case where the read goes to memory and is not forwarded from the store buffer. The value read is @{term "v=msbh a"}. Moreover, we make a case distinction wheter there is an outstanding volatile write in the store buffer of thread @{term i} or not. This determines if there are suspended instructions in the virtual machine or not. We start with the case where there is no such write. This means that there are no suspended instructions in thread @{term i} and therefore @{term "cfg''=cfg"}. 
We have to show that the virtual machine reads the same value from memory: @{term "v = m a"}. So what can go wrong? When can the the memory of the virtual machine hold a different value? The memory of the virtual machine is obtained from the memory of the store buffer machine by executing all store buffers until we hit the first volatile write. So if there is a discrepancy in the value this has to come from a non-volatile write in the executed parts of another thread, let us say thread @{term j}. This write is marked as x in Figure~\ref{fig:coupling-i-read-conflict}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\begin{figure}
\centering
\begin{tikzpicture}
\tikzstyle{sbnodel}=[shape=rectangle, draw=black, text badly centered,  outer sep=0cm]
\tikzstyle{sbnoder}=[shape=rectangle, draw=black, text ragged, outer sep=0cm]
\tikzstyle{nonvolatile}=[fill=gray!10]%todo rename to executed?
\tikzstyle{virtual}=[dotted]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Store buffers and instructions %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\node (sbl0) [style=sbnodel,style=nonvolatile,text width=1.3cm] {nv};
\node (sbr0) [style=sbnoder,text width=1.7cm, right] at(sbl0.east) {v};
\node (ins0) [right] at ($ (sbr0.east) $) {thread $0$: $i_0^0$, $i_0^1$, $\dots$};

\node (sbl1) [style=sbnodel,style=nonvolatile,text width=2.0cm,below right] at ($ (sbl0.south west) -(0,0.6cm) $) {nv};
\node (sbr1) [style=sbnoder,style=nonvolatile,text width=1.0cm, right] at(sbl1.east) {v};
\node (ins1) [right] at ($ (sbr1.east) $) {thread $i$: @{term "Readsb volatile a t"},$\dots$};


\node (sbl2) [style=sbnodel,style=nonvolatile,text width=1.7cm,below right] at ($ (sbl1.south west) -(0,0.6cm) $) {x};
\node (sbr2) [style=sbnoder,text width=1.3cm, right] at(sbl2.east) {v};
\node (ins2) [right] at ($ (sbr2.east) $) {thread $j$: $i_j^0$, $i_j^1$, $\dots$};

\node (sbl3) [style=sbnodel,style=nonvolatile,text width=1.4cm,below right] at ($ (sbl2.south west) -(0,0.6cm) $) {nv};
\node (sbr3) [style=sbnoder,text width=1.6cm, right] at(sbl3.east) {v};
\node (ins3) [right] at ($ (sbr3.east) $) {thread $n$: $i_n^0$, $i_n^1$, $\dots$};

\path (sbr1.north east)  to node [near end,left] {$\vdots$} (sbr0.south east);
\path (sbr2.north east)  to node [near end,left] {$\vdots$} (sbr1.south east);
\path (sbr3.north east)  to node [near end,left] {$\vdots$} (sbr2.south east);

\node (sblabel)[above]  at ($ (sbr0.north west) +(0,0.6cm)$) {$\leftarrow$ store buffers};
\node (inslabel)[above]  at ($ (sbr0.north east) +(1.5cm,0.6cm)$) {$\leftarrow$ instructions};

%%%%%%%%%%
% Memory %
%%%%%%%%%%
\coordinate (memNorthWest) at ($ (sbl0.north west) -(2.0cm,0cm) $);
\coordinate (memSouthEast) at ($ (sbl3.south west) -(0.5cm,0cm) $);
\filldraw[style=nonvolatile,rounded corners]  (memNorthWest) rectangle  (memSouthEast) node [midway] {@{term "msbh"}};

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Virtual memory boundaries %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\draw [style=virtual,out=90,in=-90](sbr1.north east) to (sbr0.south west);
\draw [style=virtual,out=90,in=-90](sbr2.north west) to (sbr1.south east);
\draw [style=virtual,out=90,in=-90](sbr3.north west) to (sbr2.south west);

\draw [style=virtual] ($ (memNorthWest) +(0,0.4cm) $) to ($ (sbr0.north west) + (-0.3,0.4)$)[out=0,in=90] to ($ (sbr0.north west)$);
\draw [style=virtual]($ (memNorthWest |- memSouthEast) +(0,-0.8cm) $) to node[midway,above]{@{term m}} ($ (sbr3.south west) + (-0.3,-0.8)$)[out=0,in=90]
  to ($ (sbr3.south west)$);

\node (execslabel)[below]  at ($ (sbl3.south)$) {executed};
\node (suspendslabel)[below]  at ($ (sbr3.south)$) {suspended};

\end{tikzpicture}

\caption{Conflicting write in thread j (marked x)  \label{fig:coupling-i-read-conflict}}
\end{figure}

We refer to x both for the write operation itself and to characterize the point in time in the computation of the virtual machine where the write was executed. At the point x the write was safe according to rules in Figure~\ref{fig:safe-delayed} for non-volatile writes. So it was owned by thread @{term j} and unshared. This knowledge about the safety of write x is preserved in the invariants, namely (Ownership.\ref{inv-ownership:owned-or-read-only})
and (Sharing.\ref{inv-sharing:non-volatile-writes-unshared}). Additionally from invariant (Sharing.\ref{inv-sharing:no-write-to-read-only-memory}) we know that address @{term a} was not read-only at point x. Now we combine this information with the safety of the read of thread @{term i} in the current configuration @{term "cfg"}: address @{term a} either has to be owned by thread @{term i}, or has to be read-only or the read is volatile and @{term a} is shared. Additionally there are the constraints on the released addresses which we will exploit below. Let us address all cases step by step.
First, we consider that address @{term a} is currently owned by thread @{term i}. As it was owned by thread @{term j} at time x there has to be an release of @{term a} in the executed prefix of the store buffer of thread @{term j}. This release is recorded in the release set, 
so we know @{term "a  dom (ℛs!j)"}. This contradicts the safety of the read. Second, we consider that address @{term a} is currently read-only.
At time x address @{term a} was owned by thread @{term j}, unshared and not read-only. Hence there was a release of address @{term a} in the executed prefix of the store buffer of @{term j}, where it made a transition unshared and owned to shared. With the monotonicity of the release sets this means 
@{term "a  dom (ℛs!j)"}, even more precisely @{term "(ℛs!j) a = Some False"}. Hence there is no chance to get the read safe (neiter a volatile nor a non-volatile). Third, consider a volatile read and that address @{term a} is currently shared. This is ruled out by the same line of reasoning as in the previous case.
So ultimately we have ruled out all races that could destroy the value at address @{term a} and have shown that we can simulate the step on the virtual machine.
This completes the simulation of the case where there is no store buffer forwarding and no volatile write in the store buffer of thread @{term i}. The other cases are handled similar. The main arguments are obtained by arguing about safety of configuration @{term cfg''} and exploiting the invariants to rule out conflicting operations in other store buffers. When there is a volatile write in he store buffer of thread @{term i} there are still pending suspended instructions in the virtual machine. Hence the virtual machine makes no step and we have to argue that the simulation relation as well as all invariants still hold.

Up to now we have focused on how to simulate the read and in particular on how to argue that the value read in the store buffer machine is the same as the value read in the virtual machine. Besided these simulation properties another major part of the proof is to show that all invariants are maintained. For example if the non-volatile read enters the store buffer we have to argue that this new entry is either owned or refers to an read-only address (Ownership.\ref{inv-ownership:owned-or-read-only}). As for the simulation above this follows from safety of the virtual machine in configuration @{term "cfg''"}. However, consider an ghost operation that acquires an address @{term a}. From safety of the configuration @{term "cfg''"} we can only infer that there is no conflicting acquire in the non-volaitle prefixes of the other store buffers. In case an conflicting acquire is in the suspended part of a store buffer of thread @{term j} safety of configuration @{term "cfg''"} is not enough. But as we have safety of all reachable states we can forward the computation of thread @{term j} until the conflicting acquire is about to be executed and construct an unsafe state which rules out the conflict.

Last we want to comment on the case where the store buffer takes a step. The major case destinction is wheter a volatile write leaves the store buffer or not. In the former case the virtual machine has to simulate a whole bunch of instructions at once to simulate the store buffer machine up to the next volatile write in the store buffer. In the latter case the virtual machine does no step at all, since the instruction leaving the store buffer is already simulated. In both cases one key argument is commutativity of non-volatile operations with respect to global effects on the memory or the sharing map. Consider a non-volatile store buffer step of thread @{term i}. In the configuration of the virtual machine before the store buffer step of thread @{term i}, the simulation relation applies the update to the memory and the sharing map of the store buffer machine, within the operations @{term "flush_all_until_volatile_write"} and @{term "share_all_until_volatile_write"} `somewhere in the middle' to obtain the memory and the sharing map of the virtual machine. After the store buffer step however, when the non-volatile operations has left the store buffer, the effect is applied to the memory and the sharing map right in the beginning. The invariants and safety sideconditions for non-volatile operations guarantee `locality' of the operation which manifests in commutativity properties. For example, a non-volatile write is thread local. There is no conflicting write in any other store buffer and hence the write can be safely moved to the beginning.

This conludes the discussion on the proof of Theorem~\ref{thm:simulation}.\qed
›

text (in xvalid_program_progress) ‹
\bigskip
The simulation theorem for a single step is inductive and can therefor be extended to arbitrary long computations.
Moreover, the coupling relation as well as the invariants become trivial for a initial configuration where all store buffers are empty and the ghost state is setup appropriately. To arrive at our final Theorem \ref{thm:reduction} we need the following steps:
\begin{enumerate}
\item \label{sim:sb-sbh} simulate the computation of the store buffer machine @{term "(tssb,m,()) sb* (tssb',m',())"} by a computation of a store buffer machine with history @{term "(tssbh,m,𝒮) sbh* (tssbh',m',𝒮')"},

\item \label{sim:sbh-delayed} simulate the computation of the store buffer machine with history by a computation of the virtual machine 
 with delayed releases @{term "(ts,m,𝒮) d* (ts',m',𝒮')"} by Theorem \ref{thm:simulation} (extended to the reflexive transitive closure),
\item \label{sim:delayed-free-flowing} simulate the computation of the virtual machine with delayed releases by a computation of the virtual machine with free flowing releases @{term "(ts,m,𝒮) v* (ts',m',𝒮')"}\footnote{Here we are sloppy with @{term ts}; strictly we would have to distinguish the thread configurations without the @{term } component form the ones with the @{term } component used for delayed releases}.
\end{enumerate} 

Step \ref{sim:sb-sbh} is trivial since the bookkeeping within the additional ghost and history state does not affect the control flow of the transition systems and can be easily removed. Similar the additional @{term } ghost component can be ignored in Step \ref{sim:delayed-free-flowing}. However, to apply Theorem \ref{thm:simulation} in Step \ref{sim:sbh-delayed} we have to convert from @{term [names_short] "safe_reach_virtual_free_flowing (ts, m, 𝒮)"} provided by the preconditions of Theorem \ref{thm:reduction} to the required @{term [names_short] "safe_reach_direct_delayed (ts, m, 𝒮)"}. This argument is more involved and we only give a short sketch here. 
The other direction is trivial as every single case for delayed releases (cf. Figure \ref{fig:safe-delayed}) immediately implies the corresponding case for free flowing releases (cf. Figure \ref{fig:safe-virtual-memory}).

First keep in mind that the predicates ensure that \emph{all} reachable configurations starting from @{term "(ts,m,𝒮)"} are safe, according to the rules for free flowing releases or delayed releases respectively. We show the theorem by contraposition and start with a computation which reaches a configuration @{term c} that is unsafe according to the rules for delayed releases and want to show that there has to be a (potentially other) computation (starting from the same initial state) that leads to an unsafe configuration @{term c'} accroding to free flowing releases. 
If @{term c} is already unsafe according to free flowing releases we have @{term "c'=c"} and are finished. 
Otherwise we have to find another unsafe configuration. 
Via induction on the length of the global computation we can also assume that for all shorter computations both safety notions coincide. 
A configuration can only be unsafe with respect to delayed releases and safe with respect to free flowing releases if there is a race between two distinct Threads @{term i} and @{term j} on an address @{term a} that is in the release set @{term ""} of one of the threads, lets say Thread @{term i}. 
For example Thread @{term j} attempts to write to an address @{term a} which is in the release set of Thread @{term i}. 
If the release map would be empty there cannot be such an race (it would simulataneously be unsafe with respect to free flowing releases). 
Now we aim to find a configuration @{term c'} that is also reachable from the initial configuration and is unsafe with respect to free flowing releases. 
Intuitively this is a configuration where Thread @{term i} is rewinded to the state just before the release of address @{term a} and Thread @{term j} is in the same state as in configuration @{term c}. 
Before the release of @{term a} the address has to be owned by Thread @{term i}, which is unsafe according to free flowing releases as well as delayed releases.
So we can argue that either Thread @{term j} can reach the same state although Thread @{term i} is rewinded or we even hit an unsafe configuration before. 
What kind of steps can Thread @{term i} perform between between the free flowing release point (point of the ghost instruction) and the delayed release point (point of next volatile write, interlocked operation or fence at which the release map is emptied)? How can these actions affect Thread @{term j}? 
Note that the delayed release point is not yet reached as this would empty the release map (which we know not to be empty). 
Thus Thread @{term i} does only perform reads, ghost instructions, program steps or non-volatile writes.
All of these instructions of Thread @{term i} either have no influence on the computation of Thread @{term j} at all (e.g. a read, program step, non-volatile write or irrelevant ghost operation) or may cause a safety violation already in a shorter computation (e.g. acquiring an address that another thread holds). This is fine for our inductive argument. So either we can replay every step of Thread @{term j} and reach 
the final configuration @{term c'} which is now also unsafe according to free flowing releases, or we hit a configuration @{term c''} in a shorter computation which violates the rules of delayed as well as free flowing releases (using the induction hypothesis).
›

section ‹PIMP \label{sec:pimp}›
text ‹
PIMP is a parallel version of IMP\cite{Nipkow-FSTTCS-96}, a canonical WHILE-language. 


An expression @{term "e"} is either 
\begin{inparaenum}
\item @{term "Const v"}, a constant value,
\item @{term "Mem volatile a"}, a (volatile) memory lookup at address @{term "a"},
\item @{term "Tmp sop"}, reading from the temporaries with a operation @{term "sop"} which is an intermediate expression occurring in the transition rules for statements,
\item @{term "Unop f e"}, a unary operation where @{term "f"} is a unary function on values, and finally
\item @{term "Binop f e1 e2"}, a binary operation where @{term "f"} is a binary function on values.
\end{inparaenum}

 
A statement @{term "s"} is either
\begin{inparaenum}
\item @{term "Skip"}, the empty statement,
\item @{term "Assign volatile a e A L R W"}, a (volatile) assignment of expression @{term "e"} to address expression @{term "a"},
\item @{term "CAS a ce se A L R W"}, atomic compare and swap at address expression @{term "a"} with compare expression 
  @{term "ce"} and swap expression @{term "se"},
\item @{term "Seq s1 s2"}, sequential composition,
\item @{term "Cond e s1 s2"}, the if-then-else statement,
\item @{term "While e s"}, the loop statement with condition @{term "e"},
\item @{term "SGhost"}, and @{term "SFence"} as stubs for the corresponding memory instructions.
\end{inparaenum}

The key idea of the semantics is the following: expressions are evaluated by issuing instructions to the memory system, then the program waits until the memory system has made all necessary results available in the temporaries, which allows the program to make another step. Figure~\ref{fig:expression-evaluation} defines expression evaluation.
%
\begin{figure}
\begin{tabularx}{\textwidth}{l@ {~~=›~~}X}
@{thm (lhs) issue_expr.simps (1) [no_vars]} & @{thm (rhs) issue_expr.simps (1) [no_vars]}\\
@{thm (lhs) issue_expr.simps (2) [no_vars]} & @{thm (rhs) issue_expr.simps (2) [no_vars]}\\
@{thm (lhs) issue_expr.simps (3) [where sop="(D,f)", no_vars]} & @{thm (rhs) issue_expr.simps (3) [where sop="(D,f)", no_vars]}\\
@{thm (lhs) issue_expr.simps (4) [no_vars]} & @{thm (rhs) issue_expr.simps (4) [no_vars]}\\
@{thm (lhs) issue_expr.simps (5) [no_vars]} & @{thm [break,margin=50] (rhs) issue_expr.simps (5) [no_vars]}\\
\end{tabularx}\\[2pt]

\begin{tabularx}{\textwidth}{l@ {~~=›~~}X}
@{thm (lhs) eval_expr.simps (1) [no_vars]} & @{thm (rhs) eval_expr.simps (1) [no_vars]}\\
@{thm (lhs) eval_expr.simps (2) [no_vars]} & @{thm (rhs) eval_expr.simps (2) [no_vars]}\\
@{thm (lhs) eval_expr.simps (3) [where sop="(D,f)", no_vars]} & @{thm (rhs) eval_expr.simps (3) [where sop="(D,f)",simplified fst_conv snd_conv, no_vars]}\\
@{thm (lhs) eval_expr.simps (4) [no_vars]} & @{thm (rhs) eval_expr.simps (4) [no_vars]}\\
@{thm (lhs) eval_expr.simps (5) [no_vars]} & @{thm [break,margin=50] (rhs) eval_expr.simps (5) [no_vars]}
\end{tabularx}
\caption{Expression evaluation\label{fig:expression-evaluation}}
\end{figure}
%
The function @{term "used_tmps e"} calculates the number of temporaries that are necessary to evaluate expression @{term "e"}, where every @{term "Mem"} expression accounts to one temporary. 
With @{term "issue_expr t e"} we obtain the instruction list for expression @{term "e"} starting at temporary @{term "t"}, whereas @{term "eval_expr t e"} constructs the operation as a pair of the domain and a function on the temporaries.

The program transitions are defined in Figure~\ref{fig:program-transitions}. We instantiate the program state by a tuple @{term "(s,t)"} containing the statement @{term "s"} and the temporary counter @{term "t"}.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] AssignAddr' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] Assign' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] CASAddr' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] CASComp' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] CAS' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] stmt_step.Seq [no_vars]}\\[-0.3\baselineskip] 
@{thm [mode=Axiom] stmt_step.SeqSkip [no_vars]} \\[0.5\baselineskip]
@{thm [mode=Rule] SCond' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] stmt_step.CondTrue [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] stmt_step.CondFalse [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] While [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] SGhost [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] SFence [no_vars]}\\[0.1\baselineskip]
\end{center}
\caption{Program transitions\label{fig:program-transitions}}
\end{figure}
%
To assign an expression @{term "e"} to an address(-expression) @{term "a"} we first create the memory instructions for evaluation the address @{term "a"} and transforming the expression to an operation on temporaries. The temporary counter is incremented accordingly. 
When the value is available in the temporaries we continue by
creating the memory instructions for evaluation of expression @{term "e"} followed by the corresponding store operation.
Note that the ownership annotations can depend on the temporaries and thus can take the calculated address into account.

Execution of compare and swap @{term "CAS"} involves evaluation of three expressions, the address @{term "a"} the compare value @{term "ce"} and the swap value @{term "se"}. 
It is finally mapped to the read-modify-write instruction @{term "RMW"} of the memory system. 
Recall that execution of @{term "RMW"} first stores the memory content at address @{term "a"} to the specified temporary. 
The condition compares this value with the result of evaluating @{term "ce"} and writes swap value @{term "sa"} if successful. 
In either case the temporary finally returns the old value read.
 
Sequential composition is straightforward. An if-then-else is computed by first issuing the memory instructions for evaluation of condition @{term "e"} and transforming the condition to an operation on temporaries. 
When the result is available the transition to the first or second statement is made, depending on the result of @{const "isTrue"}.
Execution of the loop is defined by stepwise unfolding.
Ghost and fence statements are just propagated to the memory system.
%

To instantiate Theorem~\ref{thm:simulation} with PIMP we define the invariant parameter @{term "valid"}, which has to be maintained by all transitions of PIMP, the memory system and the store buffer. 
Let @{term "θ"} be the valuation of temporaries in the current configuration, for every thread configuration @{term "tssb!i = ((s,t),is,θ,sb,𝒟,𝒪)"} where @{term "i < length tssb"} we require:
%
\begin{inparaenum}
\item The domain of all intermediate @{term "Tmp (D,f)"} expressions in statement @{term "s"} is below counter @{term "t"}.
\item All temporaries in the memory system including the store buffer are below counter @{term "t"}.
\item All temporaries less than counter @{term "t"} are either already defined in the temporaries @{term "θ"} or are outstanding read temporaries in the memory system.
\end{inparaenum}

For the PIMP transitions we prove these invariants by rule induction on the semantics.
For the memory system (including the store buffer steps) the invariants are straightforward. 
The memory system does not alter the program state and does not create new temporaries, only the PIMP transitions create new ones in strictly  ascending order. 
›



(*<*)
end
(*>*) 

Theory Preliminaries

(*<*)
theory Preliminaries
imports Abbrevs
begin


record foorecord = fld1 :: nat fld2 ::nat
datatype foodatatype = Foo
notation (latex output)
Foo ("latex‹\\constructor{Foo}›")

(* TODO:
setup {*add_constructor_syntax "latex" "Preliminaries.foodatatype" *}
*)
(*>*)
section ‹Preliminaries \label{sec:preliminaries}›
text ‹
The formalization presented in this papaer is mechanized and checked within the generic interactive theorem prover \emph{Isabelle}\cite{Paulson:IGTP94}. 
Isabelle is called generic as it provides a framework to formalize various \emph{object logics} declared via natural deduction style inference rules.
The object logic that we employ for our formalization is the higher order logic of \emph{Isabelle/HOL}\cite{Nipkow:IHOL02}. 

This article is written using Isabelle's document generation facilities, which guarantees a close correspondence between the presentation and the actual theory files.
We distinguish formal entities typographically from other text. 
We use a sans serif font for types and constants (including functions and predicates), \eg @{term "map"}, a slanted serif font for free variables, \eg @{term "x"}, and a slanted sans serif font for bound variables, \eg @{term "Bind x. x"}.
Small capitals are used for data type constructors, \eg @{term[names_short] "Foo"}, and type variables have a leading tick, \eg  @{typ "'a"}. HOL keywords are typeset in type-writer font, \eg \holkeyword{let}. %We also take the freedom to borrow C notation, \eg @{term "UnsgndT"} when presenting C0.

To group common premises and to support modular reasoning Isabelle provides \emph{locales}\cite{Ballarin:TYPES03-34,Ballarin:MKM06-31}. 
A locale provides a name for a context of fixed parameters and premises, together with an elaborate infrastructure to define new locales by inheriting and extending other locales, prove theorems within locales and interpret (instantiate) locales. In our formalization we employ this infrastructure to separate the memory system from the programming language semantics. 

The logical and mathematical notions follow the standard notational conventions with a bias towards functional programming. 
We only present the more unconventional parts here. 
We prefer curried function application, \eg @{term "f a b"} instead of @{term [mode=uncurry] "f a b"}.
In this setting the latter becomes a function application to \emph{one} argument, which happens to be a pair.

Isabelle/HOL provides a library of standard types like Booleans, natural numbers, integers, total functions, pairs, lists, and sets. Moreover, there are packages to define new data types and records. 
Isabelle allows polymorphic types, \eg @{typ "'a list"} is the list type with type variable @{typ "'a"}. 
In HOL all functions are total, \eg @{typ "nat  nat"} is a total function on natural numbers. 
A function update is @{thm fun_upd_def[of f y v]}.
To formalize partial functions the type @{typ "'a option"} is used. 
It is a data type with two constructors, one to inject values of the base type, \eg @{term "Some x"}, and the additional element @{term "None"}. 
A base value can be projected with the function @{term "the"}, which is defined by the sole equation @{thm option.sel [of x]}. 
Since HOL is a total logic the term @{term "the None"} is still a well-defined yet un(der)specified value. 
Partial functions are usually represented by the type latex‹\tfreeify{›'alatex‹}› ⇒ latex‹\tfreeify{›'blatex‹}› option›, abbreviated as @{typ  "'a  'b"}. 
They are commonly used as \emph{maps}. 
%With @{term "map_of xs"} we construct a map from an association list, \ie a list of key~/~value pairs. 
We denote the domain of map  @{term "m"} by @{term "dom m"}. % not used: and to its range by @{term "ran m"}. 
A map update is written as @{term "m(a := Some v)"}.
%With @{term "m1 ++ m2"} we add the map @{term "m2"} to map @{term "m1"}, where entries of @{term "m1"} are overwritten if necessary. 
We can restrict the domain of a map @{term "m"} to a set @{term "A"} by @{term "m |` A"}. 
%Subsumption of maps is defined as @{thm "map_le_def" [of m1 m2]} and composition of maps as @{thm "map_comp_def" [of m1 m2]}.

%\paragraph{Lists.}
The syntax and the operations for lists are similar to functional programming languages like ML or Haskell. 
The empty list is @{term "[]"}, with @{term "x#xs"} the element @{term "x"} is `consed' to the list @{term "xs"}.%, the head of list @{term "xs"} is @{term "hd xs"} and the remainder, its tail, is @{term "tl xs"}. 
With @{term "xs@ys"} list @{term "ys"} is appended to list @{term "xs"}.
With the term @{term "map f xs"} the function @{term "f"} is applied to all elements in @{term "xs"}. 
The length of a list is @{term "length xs"}, the @{term n}-th element of a list can be selected with @{term "xs!n"} and can be updated via @{term "xs[n:=v]"}. With @{term "dropWhile P xs"} the prefix for which all elements satisfy predicate @{term "P"} are dropped from list @{term "xs"}.
%With @{term "set xs"} we obtain the set of elements in list @{term "xs"}.
%Filtering those elements from a list for which predicate @{term "P"} holds is achieved by @{term [eta_contract=false] "[xxs. P x]"}.
%With @{term "replicate n e"} we denote a list that consists of @{term n} elements @{term e}.

%\paragraph{Sets.}
Sets come along with the standard operations like union, \ie @{term "A  B"}, membership, \ie @{term "x  A"} and set inversion, \ie @{term "- A"}.

%intersection, \ie @{term "A  B"} and 
%The set image @{term "f ` A"} yields a new set by applying function @{term "f"} to every element in set @{term "A"}.




%\paragraph{Records.}
%A record is constructed by assigning all of its fields, \eg @{term "fld1 = v1, fld2 = v2"}.
%Field @{term [names_short]"fld1"} of record @{term "r"} is selected by @{term[names_short] "fld1 r"} and updated with a value @{term "x"} via @{term[names_short] "rfld1 := x"}. 

%\paragraph{Tuples.}
%The first and second component of a pair can be accessed with the functions @{const fst} and @{const snd}. 
Tuples with more than two components are pairs nested to the right.

›
(*<*)
end
(*>*)